Guest User

sony 1

a guest
May 6th, 2011
2,660
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. #!/usr/local/bin/perl
  2.  
  3.  
  4. eval {
  5.  
  6. #########################################################
  7. # Read in the string from the form
  8. #########################################################
  9.  
  10. if ($ENV{'REQUEST_METHOD'} eq "GET") {
  11. $FORM_DATA = $ENV{'QUERY_STRING'};
  12. } else {
  13. $LENGTH = $ENV{'CONTENT_LENGTH'};
  14. while ($LENGTH) {
  15. $FORM_DATA .= getc(STDIN);
  16. $LENGTH--;
  17. }
  18. }
  19.  
  20. #########################################################
  21. # Split the input string into individual variables
  22. #########################################################
  23.  
  24.  
  25. foreach (split(/&/, $FORM_DATA)) {
  26. ($NAME, $VALUE) = split(/=/, $_);
  27. $NAME =~ s/\+/ /g;
  28. $NAME =~ s/%([0-9|A-F]{2})/pack(C,hex($1))/eg;
  29. $VALUE =~ s/\+/ /g;
  30. $VALUE =~ s/%([0-9|A-F]{2})/pack(C,hex($1))/eg;
  31. # find a unique name for select boxes
  32. $NUM ="0";
  33. while ($FORMDATA{$NAME} ne "") {
  34. $NUM++;
  35. $NAME =~ s/\.([0-9]+$)|$/\.$NUM/;
  36. }
  37. $FORMDATA{$NAME} = $VALUE;
  38. }
  39.  
  40. $product = $FORMDATA{"product"};
  41. $product =~ tr/a-z/A-Z/;
  42.  
  43. $docdirname = "/ws/w1/htmldocs/shared/semi/PDF/";
  44. $docext = "pdf";
  45. $docurlbase = "/semi/PDF/";
  46.  
  47. $filename = "$docdirname$product.$docext";
  48. $default = "$product.$docext";
  49.  
  50. local(@matched, @ids, $re);
  51. # get a list of the product ids
  52. opendir(DOCDIR, $docdirname) || die($ENV{'SCRIPT_NAME'}||$0. ": opendir(): can't open directory \"$docdirname\": $!\n");
  53. @ids = readdir(DOCDIR);
  54. closedir(DOCDIR);
  55. @ids = grep(/\.$docext$/i && s/\.$docext$//i, @ids);
  56.  
  57. if(@matched == 0) {
  58. # make a regexp of possible $product matches
  59. $re = $product;
  60.  
  61. # look for match
  62. @matched = grep(/$re/i, @ids);
  63. }
  64. if(@matched == 0) {
  65. # make a regexp of possible $product matches
  66. $re = join("|", omit_list(+1, $product),
  67. omit_list(-1, $product),
  68. miss_list(-1, $product),
  69. transpose_list($product));
  70. $re = '^(?:'.$re.')$';
  71.  
  72. # look for match
  73. @matched = grep(/$re/i, @ids);
  74. }
  75.  
  76. # sort @matched
  77. sub sortsub {
  78. my $ta, $tb;
  79. ($ta = $a) =~ tr/A-Z/a-z/;
  80. ($tb = $b) =~ tr/A-Z/a-z/;
  81. $ta cmp $tb;
  82. }
  83. @matched = sort sortsub @matched;
  84.  
  85. # if((! -r $filename) && (@matched != 1))) {
  86. if(@matched == 1) {
  87. $errmsg = "<p>The product code you entered, $product, is similar to this product: ".
  88. join("", map("<a href=\"$docurlbase$_.$docext\">$_</a>", @matched)).
  89. ". If this is not what you wanted, you can try another product code, or go to a product category, by selecting it below.";
  90. } elsif(@matched > 1) {
  91. $errmsg = "<p>The product code you entered, $product, is similar to these products: <ul>".
  92. join("", map("<li><a href=\"$docurlbase$_.$docext\">$_</a>", @matched)).
  93. "</ul> <p>If none of these are what you wanted, you can try another product code, or go to a product category, by selecting it below.";
  94. } else {
  95. $errmsg = "<p><center><H2>Sorry, the product code you entered does not exist. Please try another product code, or go to a product category by selecting it below.</H2></center>";
  96. }
  97. };
  98.  
  99.  
  100. ###
  101. ###
  102. $error_file = "/ws/w1/htmldocs/shared/semi/searcherror.html";
  103. $errmsg_spot_re = "<!--%ERRGOESHERE%-->";
  104.  
  105.  
  106. if($errmsg || $@) {
  107. $errmsg = $errmsg || "the script encountered a serious problem and couldn't complete your request: $@";
  108.  
  109. print("Content-type: text/html\n\n");
  110. open(ERROR, $error_file);
  111. $e = join("", (<ERROR>));
  112. close(ERROR);
  113.  
  114. if($e ne '') {
  115. $e =~ s/$errmsg_spot_re/$errmsg/g;
  116. } else {
  117. $e = "Serious error: $!, and $errmsg";
  118. }
  119. $e .= "\n";
  120. print($e);
  121. }
  122.  
  123.  
  124.  
  125. # package alink::oneoff;
  126.  
  127. sub uniq { my %H = (); grep(!$H{$_}++, @_); }
  128. sub nonuniq { my %H = (); grep($H{$_}++ == 1, @_); }
  129.  
  130. sub omit_list {
  131. my $e_len = shift;
  132. my @R = ();
  133.  
  134. my $g;
  135. foreach $g (@_) {
  136. my $g_len = length($g);
  137.  
  138. if($e_len > 0) {
  139. push(@R, uniq(omit_list($e_len-1, map(substr($g,0,$_).".".substr($g,$_), (0..$g_len)))));
  140. } elsif($e_len < 0) {
  141. push(@R, uniq(omit_list($e_len+1, map(substr($g,0,$_).substr($g,$_+1), (0..$g_len-1)))));
  142. } else {
  143. push(@R, $g);
  144. }
  145. }
  146.  
  147. @R;
  148. }
  149.  
  150. sub miss_list {
  151. my $e_len = shift;
  152. my @R = ();
  153.  
  154. my $g;
  155. foreach $g (@_) {
  156. my $g_len = length($g);
  157.  
  158. if($e_len < 0) {
  159. push(@R, uniq(miss_list($e_len+1, map(substr($g,0,$_).".".substr($g,$_+1), (0..$g_len-1)))));
  160. } else {
  161. push(@R, $g);
  162. }
  163. }
  164.  
  165. @R;
  166. }
  167.  
  168. sub transpose_list {
  169. my @R = ();
  170.  
  171. my $g;
  172. foreach $g (@_) {
  173. my $g_len = length($g);
  174. push(@R, uniq(map(substr($g,0,$_-1).substr($g,$_,1).substr($g,$_-1,1).substr($g,$_+1), (1..$g_len-1))));
  175. }
  176.  
  177. @R;
  178. }
  179.  
  180. ## examples
  181.  
  182. ## fetch some words
  183. #chop(@l = (<>));
  184.  
  185. ## regexps for if one letter was omitted
  186. #print(map($_."\n", omit_list(+1, @l)));
  187.  
  188. ## regexps for if one extra letter was added
  189. #print(map($_."\n", omit_list(-1, @l)));
  190.  
  191. ## regexps for if one letter was screwed up
  192. #print(map($_."\n", miss_list(-1, @l)));
  193.  
  194. ## regexps for if two letters were transposed
  195. #print(map($_."\n", transpose_list(@l)));
  196.  
  197. ## possible matches if one letter were omitted
  198. #print(map($_."\n", omit_list(-1, @l)));
  199.  
  200. ## possible matches if two letters were transposed
  201. #print(map($_."\n", transpose_list(@l)));
  202.  
  203.  
  204. ## check for possible collisions if one letter were omitted
  205. #print(map($_."\n", nonuniq(omit_list(-1, @l))), "\n");
  206.  
  207. ## check for possible collisions if two letters were transposed
  208. #print(map($_."\n", nonuniq(transpose_list(@l))), "\n");
  209.  
  210. # end
RAW Paste Data