#!/usr/bin/perl -w
use strict;
use Getopt::Std;

# please note that since there is a lot of development going on, there's a lot
# of comments. You can either ignore them, or email muncus@ccs.neu.edu with 
# comments of your own. thanks.


# SkinCat V1.0
# As the saying goes, there's more than one way to skin the [:Cue:]Cat. :o)
# this script does the web query of a barcode, without including your unique
# tracking number, and parses the returned information.

# This code is released under the terms of the GPL. Please refer to the 
# GNU Project website (http://www.gnu.org) for the full test of the GPL.

# Muncus / Bistromath, 9/20/2000.

sub MkISBNDigit($);
sub decodeTriplet($);

srand();
our $opt_s = "";
getopts("s");

#change below to a higher number for longer timeout on web queries.
my $wget_timeout=3;

print "Ready to scan. press ^C when finished.\n";
while ( my $RawCue=<STDIN>) {
  if ($RawCue=~s/.*?\.([\w\d]+?\.[\w\d]{4}\.[\w\d]+?\.)/$1/){
    ( my $cue = $RawCue) =~ tr/A-Za-z/a-zA-Z/;

    (my $codedID, my $codedType, my $codedUpc) = split(/\./, $RawCue); 
    #decode the UPC number and product code

    #product type first...
    my $type = decodeTriplet($codedType);
    print "Product type: $type\n";

    #now decode the UPC...
    my $codedUpcTriplet;
    my $upcTriplet;
    my $upcString;

    #does this even *do* anything?
    #i dont think so.
    #pad any remainders with zeroes ('a'). not doing the trick yet. blame pierre.
    while(length($codedUpc) % 4){
      $codedUpc = $codedUpc . 'a';
    }

    my @upcArray = split //, $codedUpc;

    while(@upcArray) {
        my @b = splice(@upcArray, 0, 4);
	$codedUpcTriplet = $b[0].$b[1].$b[2].$b[3];
	$upcTriplet = decodeTriplet($codedUpcTriplet);
	$upcString .= $upcTriplet;
    }
    
    #okay, nice way to handle these UPC errors i've been getting, but some items will still
    #trigger this error since the decoding code is a bit flaky. Anything of type CBR, or some UPE's.
    #Please note this only affects the printing of the UPC - your online lookup still functions normally.
    #Therefore, since it's only the decoder's fault and the decoded UPC isn't needed for anything but the
    #Amazon lookup (which the decoder works well for), I'm going to take this error handler out. When the
    #decoder works correctly for all cases I'll put it back in. I'm still not convinced the CueCat correctly
    #handles UPE's; sometimes it calls them CBR on a bad read. Try a Coke can and see.

    print "Product UPC: $upcString\n";
    #validate the newly decoded UPC..
    if ($upcString =~/[^\d]/){ warn "invalid character UPC. try again.\n"; next;};

    #if it's a book, calculate the ISBN.
    if($type =~/^IB/){
      my $rn = int(rand(9));
      #use a substr().
      my @upc = split //, $upcString;
      my $junk = splice( @upc, 0,3);
      @upc = splice(@upc, 0, 9);
      my $isbn = "";
      while (@upc){
        $junk = splice(@upc, 0,1);
        $isbn .= $junk;
      }
      $isbn .= MkISBNDigit($isbn);


      #amazon.com lookup code 
      my $aurl = "http://www.amazon.com/exec/obidos/ASIN/$isbn";

      #i'm inspired. let's have it get more detailed book info..
      system "wget -T$wget_timeout -q -O ~/.amazon.$$.$rn  ${aurl}";
      my $title = `grep "<b><font face=verdana,arial,helvetica>" ~/.amazon.$$.$rn`; 
      chomp $title;
      $title=~s/<.*?>//g;
      my $author = `grep "by <a href=" ~/.amazon.$$.$rn`;
      chomp $author;
      $author =~ s/<.*?>//g;
      $author =~ s/.*\n//g;
      $author =~ s/by //;
      
      print "\nAmazon Database Info:\n---------------------\nAmazon URL: $aurl \n";
      if($title =~ /^[\s]*$/) {
          print "Book not found on Amazon or error fetching page.\n";
      }
      else {
          print "Title: $title\n";
          print "Author(s): $author\n";
      }
      
      #cleanup time..
        `rm -f ~/.amazon.$$.$rn`
    }
    
    #for all items:
    #get info from DCNV.com..
    my $url = "http://u.dcnv.com/CRQ/1..ACTIVATIONCODE.04.${cue}";
    open(ITEM, "wget -T$wget_timeout -q -O - ${url} |");
    my @Item = <ITEM>;
    close ITEM;
    
    $Item[1] =~ s/url=//;
    chomp $Item[1];
    $Item[2] =~ s/desc=//;
    chomp $Item[2];
    
    #just for fun..
    $Item[4]=~ s/img=//;
    if ($Item[4]=~/\w+/) { print "IMG tag: $Item[4]";};
    
    print "\nDCNV Database Info:\n-------------------\n";
    if ($Item[2] =~ /unresolved cues/){
      print "Item not found in DCNV database.\nCreate item: $Item[1]\n";
    }
    elsif( $type=~/^IB/){
      print "URL: $Item[1]\n\n";
    }
    else{
      print "URL: $Item[1]\nDESC: $Item[2]\n\n";
    }

    #check for single-run commandline flag..
    if($opt_s){last;};
  }
  else { print "Bad Read, or Invalid Input.\n";};
}

#sub declarations.

# this routine is based on Colin Cross' algorithm and Pierre Philippe-Coupard's C code.
sub decodeTriplet($){ 

  my @codedTriplet = split(//,$_[0]);
  my $incNumber = 0; #each character added to...
  my $totalNumber = 0; #the 24 bit number

  for(my $i = 0; $i < 4; $i++) {
      if($codedTriplet[$i] =~/[a-z]/) { $incNumber = ord($codedTriplet[$i]) - ord("a"); }
      elsif($codedTriplet[$i] =~/[A-Z]/) { $incNumber = ord($codedTriplet[$i]) - ord("A") + 26; }
      elsif($codedTriplet[$i] =~/\d/) { $incNumber = ord($codedTriplet[$i]) - ord("0") + 52; }
      elsif($codedTriplet[$i] eq "+") { $incNumber = 62; }
      elsif($codedTriplet[$i] eq "-") { $incNumber = 63; }
      #could this be made nicer? perhaps something to trap a return of 0?
      #i think this is what goes hoopy, and gives undefined warnings. it should be checked
      #  to see how it returns, and error/proceed accordingly.
      else { print "Invalid character input: $codedTriplet[$i] \n"; return 0;};
    
    $totalNumber = $totalNumber << 6 | $incNumber; #shift left six bits and OR with the six bit number: addition.
  }

  # ASCIIfying magic and put into return array
  return pack("c*",(($totalNumber >> 16) ^ 67, ($totalNumber >> 8 & 255) ^ 67, ($totalNumber & 255) ^ 67));
}

sub MkISBNDigit($){
  my $isbn = shift();
  my @isbn = split //, $isbn;
  my $a;
  my $b;
  my $digit;

  for(my $i=0; $i < 9; $i++){
      $digit = 10-$i;
    $a = $digit * $isbn[$i];
    $b += $a;
    $digit = (11-($b%11));
  };
  return $digit;
}