#!/usr/bin/perl # # webqcat.pl - CGI script to process and format CueCat barcode data # # Versions: # Version 1.01 (October 1, 2000) # Implemented John Galt's suggestion to speed up lookups # from dcnv.com, added bestbookbuys code from Fawad Halim # Version 1.00 (September 30, 2000) # Initial version # # Copyright (C) 2000 Micah Dowty # # This program is free software; you can redistribute it and/or # modify it under the terms of the GNU General Public License # as published by the Free Software Foundation; either version 2 # of the License, or (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. # use CGI; $q = new CGI; print $q->header('text/html'); $dat = $q->param('data'); print <WebQcat Report EOF # Find and convert barcodes while ($dat =~ s/(\.[^\.]*\.(.{4}\.[^\.]+\.))//) { $_ = $1; $originalcode = $2; # Larry Wall's tiny decoder ($serial,$type,$code) = map { tr/a-zA-Z0-9+-/ -_/; $_ = unpack 'u', chr(32 + length()*3/4) . $_; s/\0+$//; $_ ^= "C" x length; } /\.([^.]+)/g; print "\n"; } print <
Generated by WebQcat (http://webqcat.sourceforge.net)
EOF # Sub to get some more info about a book sub bookinfo { $server = "shop.barnesandnoble.com"; $port = 80; $document = "/BookSearch/isbnInquiry.asp?ean=$_[0]"; $document =~ s/\s//g; ($dummy,$dummy,$dummy,$dummy, @addrs) = gethostbyname($server); $remote = pack("S n a4 x8", 2, $port, $addrs[0]); socket(S, 2, 1, join("", getprotobyname('tcp'))) || die "socket: $!"; connect(S, $remote) || die "connect: $!"; select(S); $| = 1; select(STDOUT); $| = 1; print S "GET $document HTTP/1.0\r\n\r\n"; $infopage = join '',; close S; print "
Type Code Information
$type$code\n"; # Convert the IB5 codes to normal IBN codes if ($type eq "IB5") { $type = "IBN"; $code = substr($code,0,13); } # Extra information depending on the type of barcode if ($type eq "IBN") { # It's a book print "Book ISBN code
\n"; # Look up extra information about it bookinfo($code) if ($q->param('bn')); bookbuy($code) if ($q->param('bbb')); } # Last resort... else { print "Other product code
\n"; dcnvinfo($originalcode) if ($q->param('dcnv')); } print "
\n"; # Picture if ($infopage =~ /(images\.barnesandnoble\.com[^\"]+)/) { print "\n"; } # Gather other information @info = (); if ($infopage =~ /[^>]*>[^>]*>([^>]+)/) { push @info, "Title\\$1"; } if ($infopage =~ /\s*([^\n]+)/) { $_ = $1; s/<[^>]*>//g; s/ /
/; push @info, "Author\\$_"; } # Display other information print "\n"; print "
\n"; foreach (@info) { s/\\/:<\/td>\n"; } print "
/; print "
$_
More information\n" } sub dcnvinfo { $server = "o.dcnv.com"; $port = 80; $_[0] =~ tr/a-zA-Z/A-Za-z/; $document = "/CRQ/1..ACTIVATIONCODE.04.x.$_[0]0"; ($dummy,$dummy,$dummy,$dummy, @addrs) = gethostbyname($server); $remote = pack("S n a4 x8", 2, $port, $addrs[0]); socket(S, 2, 1, join("", getprotobyname('tcp'))) || die "socket: $!"; connect(S, $remote) || die "connect: $!"; select(S); $| = 1; select(STDOUT); $| = 1; print S "GET $document HTTP/1.0\r\n\r\n"; # Using an alternate reading method to fix the # problem observed by John Galt while () { chomp; $url = $1 if (/^url=(.*)/); if (/^desc=(.*)/) { $desc = $1; last; } } close(S); if ($url =~ /c-me-register/) { print "Unknown"; return; } print "$desc
\n$url\n"; } # This code is adapted from Fawad Halim's suggestion sub bookbuy { # Calculate ISBN code with check digit $temp = substr($_[0],3,9); $x=$temp+0; $temp2=0; for ($z=2;$z<=10;$z++) { $t=int($x/10); $y=$x%10; $temp2+=($y*$z); $x=$t; } $temp2=11-($temp2%11); $temp=$temp.$temp2; # Look up price $server = "bestbookbuys.com"; $port = 80; $document="/cgi-bin/bbb.cgi?searchtype=ISBN&search.x=37&search.y=22&searchparam=$temp"; ($dummy,$dummy,$dummy,$dummy, @addrs) = gethostbyname($server); $remote = pack("S n a4 x8", 2, $port, $addrs[0]); socket(S, 2, 1, join("", getprotobyname('tcp'))) || die "socket: $!"; connect(S, $remote) || die "connect: $!"; select(S); $| = 1; select(STDOUT); $| = 1; print S "GET $document HTTP/1.0\r\n\r\n"; $infopage = join '',; close S; if ($infopage =~ />(\$[^<]+)/) { print "
Best price:\n"; print "$1 \n"; } if ($infopage =~ /List Price:[^\$]*(\$[^<]+)/) { print "(List price: $1)\n"; } } ### The End ###