Root/
| 1 | #!/usr/bin/perl |
| 2 | |
| 3 | $BASE = "http://search.digikey.com/scripts/DkSearch/dksus.dll"; |
| 4 | #$QMOD = "stock=1&pbfree=1&rohs=1"; |
| 5 | $QMOD = "pbfree=1&rohs=1"; |
| 6 | $URL = "$BASE?$QMOD&k="; |
| 7 | |
| 8 | $DEBUG = 0; |
| 9 | |
| 10 | |
| 11 | sub query |
| 12 | { |
| 13 | local @q = (); |
| 14 | |
| 15 | open(PIPE, "wget -O - '$_[0]' |") || die "wget: $!"; |
| 16 | while (<PIPE>) { |
| 17 | chop; |
| 18 | push(@q, $_); |
| 19 | } |
| 20 | close PIPE; |
| 21 | return @q; |
| 22 | } |
| 23 | |
| 24 | |
| 25 | # --- Read query specification ------------------------------------------------ |
| 26 | |
| 27 | |
| 28 | if ($ARGV[0] eq "-t") { |
| 29 | $test = 1; |
| 30 | shift @ARGV; |
| 31 | } |
| 32 | |
| 33 | $spec = $ARGV[0]; |
| 34 | |
| 35 | while (<>) { |
| 36 | s/#.*//; |
| 37 | next if /^\s*$/; |
| 38 | chop; |
| 39 | push(@q, $_); |
| 40 | } |
| 41 | |
| 42 | $id = shift @q; |
| 43 | $key = shift @q; |
| 44 | $cat = shift @q; |
| 45 | ($topcat, $cat) = ($`, $') if $cat =~ m|/|; |
| 46 | |
| 47 | for (@q) { |
| 48 | die "not a field=value pair: \"$_\"" unless /\s*=\s*/; |
| 49 | push(@{ $f{$`} }, $'); |
| 50 | } |
| 51 | |
| 52 | |
| 53 | # --- Select category --------------------------------------------------------- |
| 54 | |
| 55 | |
| 56 | $url = $URL.$key; |
| 57 | |
| 58 | @q = &query($url); |
| 59 | |
| 60 | if ($q[1] =~ /<title>Digi-Key</) { |
| 61 | undef $found; |
| 62 | for (@q) { |
| 63 | $on = $1 eq $topcat if |
| 64 | defined $topcat && /catfiltertopitem>\s*(.*?)\s*</; |
| 65 | next if defined $topcat && !$on; |
| 66 | next unless /Cat=(\d+)[&"].*?>\s*(.*?)\s*[(<]/; |
| 67 | next if $2 ne $cat; |
| 68 | $found = $1; |
| 69 | last; |
| 70 | } |
| 71 | |
| 72 | die "category \"$cat\" not found" unless defined $found; |
| 73 | |
| 74 | |
| 75 | # --- Get parameter tables ---------------------------------------------------- |
| 76 | |
| 77 | |
| 78 | $url .= "&Cat=$found"; |
| 79 | |
| 80 | @q = &query($url); |
| 81 | } |
| 82 | |
| 83 | for (@q) { |
| 84 | if (/^<th>\s*(.*?)\s*<\/th>/) { |
| 85 | print STDERR "col name \"$1\"\n" if $DEBUG; |
| 86 | push(@col_name, $1); |
| 87 | next; |
| 88 | } |
| 89 | if (/<select .* name=([^ >]+)/) { |
| 90 | $cols++; |
| 91 | $col = $col_name[$cols-1]; |
| 92 | die "cols = $cols" unless defined $col; |
| 93 | print STDERR "$col -> \"$1\"\n" if $DEBUG; |
| 94 | $col_field{$col} = $1; |
| 95 | next; |
| 96 | } |
| 97 | next unless /<option value=(\d+)>\s*(.*?)\s*(<.*)?$/; |
| 98 | print STDERR "val{$col}{$2} = \"$1\"\n" if $DEBUG; |
| 99 | $val{$col}{$2} = $1; |
| 100 | } |
| 101 | |
| 102 | for (keys %f) { |
| 103 | $field = $col_field{$_}; |
| 104 | die "no such field: $_" unless defined $field; |
| 105 | for $v (@{ $f{$_} }) { |
| 106 | $value = $val{$_}{$v}; |
| 107 | die "no such value: \"$_\"=\"$v\"" unless defined $value; |
| 108 | $url .= "&$field=$value"; |
| 109 | } |
| 110 | } |
| 111 | |
| 112 | |
| 113 | # --- Stop here if in test mode ----------------------------------------------- |
| 114 | |
| 115 | |
| 116 | if ($test) { |
| 117 | print "$url\n"; |
| 118 | exit(0); |
| 119 | } |
| 120 | |
| 121 | |
| 122 | # --- Output file header ------------------------------------------------------ |
| 123 | |
| 124 | |
| 125 | print "#EQU\n# Generated from $spec\n# ".`date`."\n"; |
| 126 | |
| 127 | |
| 128 | # --- Get the pages ----------------------------------------------------------- |
| 129 | |
| 130 | |
| 131 | $url =~ s/\?/?Selection\&/; # magic key to the pages |
| 132 | $page = 1; |
| 133 | |
| 134 | while (1) { |
| 135 | @q = &query("$url&page=$page"); |
| 136 | $more = 0; |
| 137 | for (@q) { |
| 138 | $more = 1 if />Next</; |
| 139 | next unless /-ND">\s*([^>]*-ND)\s*<\/a><\/td><td>\s*(.*?)\s*</; |
| 140 | print "DIGI-KEY $1\t $id $2\n"; |
| 141 | } |
| 142 | last unless $more; |
| 143 | $page++; |
| 144 | } |
| 145 |
Branches:
master
