#!/usr/bin/perl

use CGI;
use CGI::Carp qw(fatalsToBrowser);
$cgi= new CGI;

if ($cgi->param('source')){&show_source;}
my($raw,@data);
$raw=$cgi->param('raw');
@data=&decode($raw);
if (defined($data[4])){
	print $cgi->redirect("$data[4]");
	exit;
} elsif (defined($data[3])){
	print $cgi->header;
	print "<h2><center>The character \"$data[3]\" is not a valid :Cue:Cat output.";
	print "<br>Please try again!</center></h2>";
	print '<form method="post" action="decode.cgi" name="decode">Scanned:<input type="text" name="raw" size="100"><input type="submit" name="decode" value="Decode!"></form>';
	exit;
} else {
	print $cgi->header;	
}

print $cgi->start_html('Cue:Cat Decoder');



print $data[2];
print "<br>$data[1]";



print <<EOF;

<h4>Actions: </h4>

<table width="100%" border=0>
<tr><td>

<!-- Barnes & Noble Submission !--> <FORM
ACTION="http://shop.barnesandnoble.com/BookSearch/search.asp?" METHOD=GET id=form1
name=form1><INPUT TYPE="hidden" name="ISBN" value="$data[2]"> <INPUT TYPE="submit"
name="SearchISBN" value="Books - Quick"></form></td><td>

<!-- Pricehunter.net Sub !--> <FORM METHOD=get
ACTION="http://www.price-hunter.net/booksearch/bottom.cgi" TARGET="_top"><INPUT
TYPE="hidden"
name="isbn" value="$data[2]"> 
        <INPUT TYPE="submit" value="Books - Best Price">
      </form></td><td>

<!-- BarPoint AudioBooks !--> <FORM NAME="CFForm_1"
ACTION="http://www.barpoint.com/html/home/searchresults.cfm"
METHOD=POST TARGET="_top"><INPUT TYPE="hidden" name="UPCNumber" value="$data[2]"><INPUT type="hidden" name="CatID" value="1"><INPUT TYPE="submit"
value="AudioBooks"></form></td><td>

<!-- BarPoint AudioBooks !--> <FORM NAME="CFForm_1"
ACTION="http://www.barpoint.com/html/home/searchresults.cfm"
METHOD=POST TARGET="_top"><INPUT TYPE="hidden" name="UPCNumber" value="$data[2]"><INPUT type="hidden" name="CatID" value="4"><INPUT TYPE="submit"
value="Computer Hardware"></form></td></tr><tr><td>

<!-- BarPoint AudioBooks !--> <FORM NAME="CFForm_1"
ACTION="http://www.barpoint.com/html/home/searchresults.cfm"
METHOD=POST TARGET="_top"><INPUT TYPE="hidden" name="UPCNumber" value="$data[2]"><INPUT type="hidden" name="CatID" value="5"><INPUT TYPE="submit"
value="Software"></form></td><td>

<!-- BarPoint AudioBooks !--> <FORM NAME="CFForm_1"
ACTION="http://www.barpoint.com/html/home/searchresults.cfm"
METHOD=POST TARGET="_top"><INPUT TYPE="hidden" name="UPCNumber" value="$data[2]"><INPUT type="hidden" name="CatID" value="6"><INPUT TYPE="submit"
value="DVD's"></form></td><td>


<!-- BarPoint AudioBooks !--> <FORM NAME="CFForm_1"
ACTION="http://www.barpoint.com/html/home/searchresults.cfm"
METHOD=POST TARGET="_top"><INPUT TYPE="hidden" name="UPCNumber" value="$data[2]"><INPUT type="hidden" name="CatID" value="13"><INPUT TYPE="submit"
value="Music"></form></td><td>


<!-- BarPoint AudioBooks !--> <FORM NAME="CFForm_1"
ACTION="http://www.barpoint.com/html/home/searchresults.cfm"
METHOD=POST TARGET="_top"><INPUT TYPE="hidden" name="UPCNumber" value="$data[2]"><INPUT type="hidden" name="CatID" value="19"><INPUT TYPE="submit"
value="Video"></form></td></tr><tr><td>

<FORM ACTION="http://wwwapps.ups.com/etracking/tracking.cgi" METHOD="GET"><INPUT
TYPE="HIDDEN" NAME="tracknums_displayed" VALUE="5">
<INPUT TYPE="HIDDEN" NAME="TypeOfInquiryNumber" VALUE="T">
<INPUT TYPE="HIDDEN" NAME="HTMLVersion" VALUE="4.0"><INPUT TYPE="hidden"
NAME="InquiryNumber1" value="$data[2]"><INPUT TYPE="submit"
value="UPS Tracking"></form></td><td>

<!-- Anything Else !--> <FORM method=post action="http://grover.mta.ca/cgi-bin/upcsearch">
<INPUT type="hidden" name="code" value="$data[2]">
<INPUT name="description" type="hidden" value="">
<Input type="submit" value="other"></form></td>


</tr></table>
EOF
print '<form method="post" action="decode.cgi" name="decode">Scan again:<input type="text" name="raw" size="100"><input type="submit" name="decode" value="Decode!"></form>';


print $cgi->end_html;

##############################################################################################

sub descram
{
my $l,@s,$encoded,$r,$n;
$seq = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-';
    ($encoded) = @_;
    @s = map { index($seq,$_); } split(//,$encoded);

    $l = ($#s+1) % 4;
    if ($l)
    {
	if ($l == 1)
	{
	    print "Error!";
	    return;
	}
	$l = 4-$l;
	$#s += $l;
    }
    $r = '';
    while ($#s >= 0)
    {
	$n = (($s[0] << 6 | $s[1]) << 6 | $s[2]) << 6 | $s[3];
	$r .=chr(($n >> 16) ^ 67) .
	     chr(($n >> 8 & 255) ^ 67) .
	     chr(($n & 255) ^ 67);
	@s = @s[4..$#s];
    }
    $r = substr($r,0,length($r)-$l);
    return $r;
}
##############################################################################################
sub decode{
my ($raw)=@_;
my @data;

#Handle Hand Entered Value (HEV)
if ($raw!~/^\./){
	$data[2]=$raw;
	$data[1]="HEV";
	$data[0]="00000000000";
	return @data;
	exit;
}
my $seq = 'abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789+-.';
#Warn about bad scans
foreach $char (split(//,$raw)){
	if ($seq!~/\Q$char\E/){
		$data[3]=$char;
		return @data;
		exit;
	}
}

my(@fields) = split(/\./,$raw);
if ($fields[2] eq "aabI"){
	$data[4]=&send_to_url($raw);
	return @data;
	exit;
}
#Do it!
(@data) = map(descram($_), @fields[1..$#fields]);
my $sum;
#Calculate the checksum's, and clip the size
if ($data[1] eq "IB5" ){
	$data[2]=substr($data[2],3,length($data[2])-(6+3));
		$sum=0;
	for ($i=0;$i<=length($data[2]);$i++){
		$sum=$sum + substr($data[2],$i,1) * ($i+1);
	}
	$sum=$sum % 11;
	
	if ($sum == 10){
		$sum = "X";
	}
} elsif ($data[1] eq "IBN") {
	$data[2]=substr($data[2],3,length($data[2])-(1+3));
		$sum=0;
	for ($i=0;$i<=length($data[2]);$i++){
		$sum=$sum + substr($data[2],$i,1) * ($i+1);
	}
	$sum=$sum % 11;
	
	if ($sum == 10){
		$sum = "X";
	}
} elsif ($data[1] eq "UPE"){
@sum=split(//,$data[2]);
	#remember, these are 0-indexed, so they look wrong! mentaly add one!
	#4+2+8=14*3=42 0+9+4+0=13 42+13=55 55/10=5R5 10-5=5
	#14*3=39+11=60/10=6R0 10-0=10 10=0
	#0407902
	$sum=((($sum[1]+$sum[3]+$sum[5])*3)+($sum[0]+$sum[2]+$sum[4]+$sum[6]))%10;
	#$sum=$tempsum%10;
	#echo "<br>\n$tempsum<br>$sum";
	#$temp.=$sum;
}


$data[2].=$sum;

return @data;
}

##############################################################################################
sub show_source {
    open(S, $0) || die("open $0: $!\n");
    print "Content-type: text/plain\n\n";
    while(<S>) { print }
    close S;
    exit;
}
##############################################################################################
sub send_to_url {
	my ($raw)=@_;
	use IO::Socket;
	
	$host = "a.dcnv.com";

	  # Invert case.
	  $raw =~ tr/[a-z][A-Z]/[A-Z][a-z]/;
	
	  # Connect to webserver.
	  unless ($handle = IO::Socket::INET->new(Proto     => 'tcp',
	                                          PeerAddr  => $host,
	                                          PeerPort  => '80'))
	  { print "Failed to connect.\n"; }
	
	  # Send query to webserver.
	  print $handle "GET /CRQ/1..ACTIVATIONCODE.04".$raw.".0 HTTP/1.0\r\n\r\n";
	
	  # Get response from webserver.
	  recv($handle, $info, 2000, 0);
	
	  # Split response into lines.
	  @lines = split(/\r\n/,$info);
	  foreach $retline (@lines)
	  {
	    ($var,$val) = split (/=/,$retline,2);
	    if ($var eq "url" or $var eq "desc")
	    {
	      $$var = $val;
	    }
	  }
	  #print "$desc\n$url\n\n";
	  return $url;
}