###############################################################################
#
# DC.pm
#
# Common utility package for Sonic Adventure CGI programs
#
# Written by Alexander Villagran, villagra@segasoft.com
#
# Ver 2.0		A. Villagran
#
###############################################################################

package DC;

use strict;

BEGIN {
	use Exporter	();
	use	CGI			();
	use CGI::Carp ('fatalsToBrowser');
	use DB;

	use POSIX	'strftime';
	use vars	qw($VERSION @ISA @EXPORT @EXPORT_OK %EXPORT_TAGS $AUTOLOAD);

	$VERSION = do {my @r = (2.00); sprintf "%d."."%02d"x$#r, @r;};

	@ISA = qw(CGI);
	@EXPORT = qw();
	%EXPORT_TAGS = ( );
	@EXPORT_OK = qw ( );
}


# ********************************************************
# Contains Smut filter, State names, and Country Names
# ********************************************************
	use vars (	'@smut', '%StateName', '%CountryName', 
				'%Flags', '@ChrCode', '@ChrCodeText', '@KanjiCodeText', '%DBaseTable',
				'%UserOff', '%ChaoOff', '%CRaceOff',
				'%RaceOff', '%WRankOff', '%LongOff', '%SurveyOff',
				'@Browsers', '%accessors'
			);

require 'strings.pl';
require 'defines.pl';

############################################################################
# %accessors defines what AUTOLOAD can see
# for simple get/set accessors
# this map operation simply results in a hash that looks like:
# ( foo=>undef, bar=>undef, baz=>undef )
############################################################################
%accessors = map { $_ => undef }
				qw ( q );

############################################################################
# User Agent strings for the 3 Sonic Adventure Browsers
############################################################################
@Browsers = (
			# US Version
			"Mozilla/3.0 (SonicKey)",
			# European Version
			"Mozilla/3.0 (DreamKey/1.0; SonicKey)",
			# Japanese Version
			"Mozilla/3.0 (DreamPassport/2.1; SonicKey)"
		);

# ********************************************************
#############################################################################
# new (<query object>)
#############################################################################
sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;

	my $query = shift;

	my $self = {};
	bless $self, $class;

	## at some point this should politely die, instead of die().
	(defined($query) && $self->q($query)) || die "No query provided!";

	return $self;
}

#############################################################################
# decode_hwid(<base 64'd id>)
# Decode Hardware ID
#############################################################################
sub decode_hwid {
	my $self = shift;		# Pointer to CGI structure
    my $srcdata = shift;
    my $hwid = "";

    # BASE64Decode
    my @val = DC::decode_base64($srcdata);
    for(my $i=0;$i<8;$i++) {
        $hwid .= sprintf "%02X",$val[$i];
    }

    return $hwid;
}

#############################################################################
# decode_base64(<base 64'd data stream>)
# returns an array derived from base64 decoding the data stream.
#
# Argument: Character lines encoded by BASE64.
# Back: Encoded bit character lines.
############################################################################
sub decode_base64 {
	my $self = shift;		# Pointer to CGI structure
    my $src = shift;
 
    my @bindata = ();
    my $bytes =0;
    my $tmpstr = "";
    my $bits ="";
    foreach my $c (split(//,$src)) {
        if($c eq '=') {
            last;
        }
        if($c =~ /[A-Z]/) {
            $bits .= substr(unpack("B*",chr(ord($c)-ord('A'))),-6,6);
        } elsif($c =~ /[a-z]/) {
            $bits .= substr(unpack("B*",chr(ord($c)-ord('a')+26)),-6,6);
        } elsif($c =~ /[0-9]/) {
            $bits .= substr(unpack("B*",chr(ord($c)-ord('0')+52)),-6,6);
        } elsif($c  eq '+') {
            $bits .= substr(unpack("B*",chr(62)),-6,6);
        } elsif($c  eq '/') {
            $bits .= substr(unpack("B*",chr(63)),-6,6);
        }

		## now stuff it per-byte into @bindata
        if(length($bits) >= 8) {
            $bindata[$bytes++] = ord(pack("B*",substr($bits,0,8)));
            $bits = substr($bits,8,length($bits)-8);
        }
    }

    return @bindata;
}

# ------------------- Not Used ------------------
#############################################################################
# encode_base64(<raw data stream>)
# returns an array derived from base64 decoding the data stream.
#
# Argument: Raw binary data.
# Back: Encoded bit character lines.
############################################################################
sub encode_base64 {
	my $self = shift;		# Pointer to CGI structure
    my $src = shift;
 
    my $retstr="";
    my $val=0;
    my $bitsnum=0;
    my $tmpval;

    foreach my $c (split(//,$src)) {
        $bitsnum+=8;
        $val=$val*256+pack("c",$c);
        while($bitsnum>=6) {
            $tmpval=($val>>($bitsnum-6))&63;
            $val=$val & ((1<<$bitsnum-6)-1);
            if($tmpval>=0 && $tmpval<26) {
                $retstr .= chr(ord('A')+$tmpval);
            } elsif($tmpval>=26 && $tmpval<52) {
                $retstr .= chr(ord('a')+$tmpval-26);
            } elsif($tmpval>=52 && $tmpval<62) {
                $retstr .= chr(ord('0')+$tmpval-52);
            } elsif($tmpval==62) {
                $retstr .= '+';
            } elsif($tmpval==63) {
                $retstr .= '/';
            }
            if((length($retstr)%73)==72) {
                $retstr .= "\n";
            }
        }
    }
    if($bitsnum>0) {
        $tmpval=($val<<(6-$bitsnum))&63;
        if($tmpval>=0 && $tmpval<26) {
            $retstr .= chr(ord('A')+$tmpval);
        } elsif($tmpval>=26 && $tmpval<52) {
            $retstr .= chr(ord('a')+$tmpval-26);
        } elsif($tmpval>=52 && $tmpval<62) {
            $retstr .= chr(ord('0')+$tmpval-52);
        } elsif($tmpval==62) {
            $retstr .= '+';
        } elsif($tmpval==63) {
            $retstr .= '/';
        }
        if((length($retstr)%73)==72) {
            $retstr .= "\n";
        }
    }
    $retstr .= "==\n";

    return $retstr;
}

############################################################################
# calc_int_time(<3 byte number to convert>)
# returns a string 
############################################################################
sub calc_int_time {
	my $self = shift;

	my $TIME = shift;
	my ($min, $sec, $hund, $str);

	$hund = ($TIME % 60);
	$min = $TIME - $hund;
	$sec = (($min%3600)/60);
	$min = ($min/3600);	
	$str = sprintf(" %d : %02d . %02d", $min, $sec, $hund*1.66);

	return $str
}

############################################################################
# crc(<reference to array of bindata from data post>)
# returns a CRC value
############################################################################
sub crc {
	my $self = shift;		# Pointer to CGI structure

	my $bindata = shift;
	my $maxbyte = $#{$bindata} + 1;
    my $val=65535;
    my $CRCPOLY1=4129;      # 0x1021

	$maxbyte = 0x50;
	#&error(1, "Max byte = ".$maxbyte);

    for(my $i=4;$i<$maxbyte;$i++) {
        $val ^= ($bindata->[$i]<<8);
        for(my $k=0;$k<8;$k++) {
            if(($val & 32768)!=0) {
                $val = ($val<<1)^$CRCPOLY1;
            } else {
                $val <<= 1;
            }
            $val &= 65535;
        }
    }
    $val ^= 65535;	# Bit Turnover
    $val &= 65535;

    return $val;
}

#############################################################################
# make_key(<users e-mail>)
# Take the users e-mail address and check to see if they exist in the
# database.  If they do not, then initialize them and give them a unique key
#
# Argument: E-mail address to search for
# Returns: Unique Key
#############################################################################
sub make_key {
	my $self = shift;		# Pointer to CGI structure
	my $email = shift;
	my $key = "";
	my ($dbh, $errN, $errstr);

	($dbh, $errstr) = DB::openOracleConnection();
	if( !$dbh )
	{
		$self->error("[make_key] Error connecting to database: $errstr");
	}

    ($errN, $errstr, $key) = DB::getUK_UserByEmail( $dbh, $DBaseTable{'USER'}, $email );
	
	if ($errN)
	{
		$self->error("[make_key] Fetching user key: $errN .... $errstr");
	}
	if ($key eq "")
	{
		# User entry was not found
	    my $b_d = retBirthDaySec(1, 1, 1900); # January/1/1900
	   ($errN, $errstr) = DB::insertRow_User( $dbh, $DBaseTable{'USER'}, "MK51000   ", $email, "", "", "", "", "N", "", $b_d, "N", "N", "N/A", "N/A", time, time, "N", 0, 0, 0, 0, 0  );
		if ($errN)
		{
			$self->error("[make_key] Creating new user entry: $errN .... $errstr");
		}

		# Read the new User Key
		($errN, $errstr, $key) = DB::getUK_UserByEmail( $dbh, $DBaseTable{'USER'}, $email );
		if ($errN)
		{
			$self->error("[Mmake_key] Fetching newly created user key: $errN .... $errstr");
		}
	}

	DB::closeOracleConnection( $dbh );

	return $key;
}

#############################################################################
# get_key(<users e-mail>)
# Take the users e-mail address and check to see if they exist in the
# database.  If they do then return the unique key
#
# Argument: E-mail address to search for
# Returns: Unique Key ("" if not found)
#############################################################################
sub get_key {
	my $self = shift;		# Pointer to CGI structure
	my $email = shift;
	my $key = "";
	my ($dbh, $errN, $errstr);

	($dbh, $errstr) = DB::openOracleConnection();
	if( !$dbh )
	{
		$self->error("[get_key] Error connecting to database: $errstr");
	}

    ($errN, $errstr, $key) = DB::getUK_UserByEmail( $dbh, $DBaseTable{'USER'}, $email );
	if ($errN)
	{
		$self->error("[get_key] Fetching user key: $errN .... $errstr");
	}

	DB::closeOracleConnection( $dbh );

	return $key;
}

#############################################################################
# retBirthDaySec(<month>, <day>, <year>)
# Will convert birthday into 
#############################################################################
sub retBirthDaySec
{
	my($mm, $dd, $yy) = @_;
	my(@dmon) = ();
	my($ny, $i, $days);

	# Days in mon 0   1   2   3   4   5   6   7   8   9  10  11  12
	my (@dmon) = (0, 31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31);

	$days = 0;
	for($i = 1900; $i < $yy; $i++)
	{
		$ny = ($i % 4 );
		if($ny == 0)
		{
			$days += 366;
		}
		else
		{
			$days += 365;
		}
	}
	$ny = ($yy % 4 );
	for($i = 1; $i < $mm; $i++)
	{
		$days += $dmon[$i];
		if($i == 2 && $ny == 0)
		{
			$days += 1;
		}
	}

	$days += $dd;
	return($days * 86400);
}

#############################################################################
# output_form(<template location>)
# takes a template and fills it in with the appropriate data from the query
#############################################################################
sub output_form {
	my $self = shift;		# Pointer to CGI structure
    my $filename = shift;

    if(open(TEMPLATE,$filename)) {
        print "Content-type: text/html\n\n";

        while(<TEMPLATE>) {
            while(s/([^<]*)(<[^<>]*>?)//) {
                print $1;
                my $tag = $2;
                if( $tag =~ /<!--Hidden:(.+)-->/ ) {
                    print "<INPUT TYPE=\"hidden\" NAME=\"$1\" VALUE=\"";
                    print $self->q->escapeHTML($self->q->param($1));
                    print "\">";
                } elsif( $tag =~ /<!--CB=(.+):(.+)-->/ ) {
                    if($self->q->param($1) eq $2) {
                        print "CHECKED"
                    }
                } elsif( $tag =~ /<!--SB=(.+):(.+)-->/ ) {
                    if($self->q->param($1) eq $2) {
                        print "SELECTED"
                    }
		} elsif( $tag =~ /<!--EMBLEMS=([0-9]+):([^,]+),(.+)-->/ ) {
		    print "<form action=\"";
		    if ($self->q->param('EMBLEMS') >= $1) {
			print "\"$2\">";
		    } else {
			print "\"$3\">";
		    }
                } elsif( $tag =~ /<!--(.+)-->/ ) {
					$self->q->autoEscape(0);
					print $self->q->param($1);
					$self->q->autoEscape(1);
                } else {
                    print $tag;
                }
            }
            print;
        }
        close(TEMPLATE);
    } else {
        $self->error("Failure to open \"$filename\".");
    }
}
 
############################################################################
# get_browser()
# returns a number from .
#
# Back: Return browser ID number. 0 = US, 1 = Europe, 2 = Japan
############################################################################
sub get_browser {
	my $self = shift;
	my $val = -1;

	my $browser = $self->q->user_agent();
	if (index($browser,$Browsers[0]) >= 0)
	{
		# US version of Sonic browser
        $val = 0;
	}
	elsif (index($browser,$Browsers[1]) >= 0)
	{
		# European version of Sonic Browser
        $val = 1;
	}
	elsif (index($browser,$Browsers[2]) >= 0)
	{
		# Japanese version of Sonic Browser
        $val = 2;
	}

	return $val;
}

############################################################################
# error(<error message>, <URL to return>)
# Error Message Display
#
# Argument: Error Message, and URL to return to
############################################################################
sub error {
	my $self = shift;		# Pointer to CGI structure
    my $mes = shift;
	my $URL = shift;

	unless (defined($URL)) {
		$URL = "community.html";
	}

    print <<EOF;
Content-type: text/html

<html>
<head>
<title>
Sonic Adventure Online - Hints
</title>
<meta name="x-uirequest" content="urlbaroff">
<script LANGUAGE = "JavaScript">
<!--
        if (document.images) {
            img1on = new Image(); 
            img1on.src = "file:/button_back_on.gif";   
            img1off = new Image(); 
            img1off.src = "file:/button_back.gif"; 
        }

function imgOn(imgName) {
        if (document.images) {
            document[imgName].src = eval(imgName + "on.src");
        }
}

function imgOff(imgName) {
        if (document.images) {
            document[imgName].src = eval(imgName + "off.src");
        }
}
// -->

</script>
</head>
<body x-marginleft=0 x-margintop=0   background="file:/bg_scroller.gif" bgcolor="#000000" marginheight=0 marginwidth=0 topmargin=0 leftmargin=0>
<center>
<img src="file:/blank_dot.gif" width=1 height=30 border=0 alt=""><br>
<table cellspacing=0 cellpadding=5 border=0 width=590><tr><td align=center valign=top bgcolor="#000033"><table cellspacing=0 cellpadding=0 border=0 width=580><tr><td align=left valign=top bgcolor="#ffffff">

<!-- HEADER IMAGE -->
<!-- choose from below... -->
<!-- header_chao_showoff.gif -->
<!-- header_events.gif -->
<!-- header_world_rankings.gif -->

<img src="file:/header_error.gif" width=580 height=150 border=0 alt=""><br>

<!-- END HEADER IMAGE -->

<table cellspacing=0 cellpadding=0 border=0 width=580><tr><td align=left valign=top width="10">
<img src="file:/blank_dot.gif" width=10 height=1 border=0 alt="">
</td>
<td align=left valign=top width=560>

<!-- BEGIN CONTENT HERE -->

<H1>$mes</H1>

<!-- END CONTENT HERE -->
<P>
<a href="http://sonic.games.dreamcast.com/$URL"  onMouseOver="imgOn('img1')" onMouseOut="imgOff('img1')"><img src="file:/button_back.gif" width=81 height=24 border=0 alt="" name="img1"></a><P>				
</td><td align=left valign=top width="10">
<img src="file:/blank_dot.gif" width=10 height=1 border=0 alt="">
</td>
</tr>
</table>
</tr>
</tr>
</table>
</td>
</tr>
</table>
<br>&nbsp;
</center>
</body>
</html>
EOF
    exit;
}

#############################################################################
# smut_check(<string to be checked>)
# returns an string where words are filtered out, and also
# breaks any word longer than 62 characters.
#
# Argument: Raw string data.
# Back: Cleaned up string.
############################################################################
sub smut_check {
	my $self = shift;		# Pointer to CGI structure
    my $str = shift;
	my $censored = '#!@%#!@%#!@%#!@%#!@%#!@%#!@%#!@%#!@%';

	# Smut checker
	for (my $loop = 0; ($smut[$loop] ne 'ENDOFLIST'); ++$loop)
	{
		$str =~ s/($smut[$loop])/substr($censored,0,length($1))/gie;
	}

	# Break up long words
	$str =~ s/(\b\S{62,}\b)/substr($1,0,62)." ".substr($1,62)/ge;

    return $str;
}

#############################################################################
# convert_katakana(<first character>, <second character>, <string>)
# returns a romanji string for the Katakana characters.
#
# Argument: First Katakana Character.
#           Second Katakana Character.
#			String to append converted text to
# Back: 0 if failed, 1 if succeeded with one character, 2 if took two characters
############################################################################
sub convert_katakana {
	my $self = shift;
	my $first = shift;
	my $second = shift;
	my $result = 0;
	my ($loop);

	if (($first >= 0x64) && ($first <= 0xB6))
	{
#		$self->error("First = ".$first.", Second = ".$second);	# For testing purposes
		# Name is in Kanji
		$loop = 0;
		while (($KanjiCodeText[$loop][0] != 0) && (!$result))
		{
			if ($first == $KanjiCodeText[$loop][0])
			{
				if ($KanjiCodeText[$loop][1] == 0)
				{
					# Single character match
					@_[0] .= $KanjiCodeText[$loop][2];
					$result = 1;
				}
				elsif ($second == $KanjiCodeText[$loop][1])
				{
					# Two character combo so skip past two characters
					@_[0] .= $KanjiCodeText[$loop][2];
					$result = 2;
				}
			}
			++$loop;
		}
	}

	return ($result);
}

#############################################################################
# state_name(<state to be converted>)
# returns an string for the full name of the state.
#
# Argument: State to display.
# Back: Full state name.
############################################################################
sub state_name {
	my $self = shift;		# Pointer to CGI structure
    my $state = shift;

    return $StateName{$state};
}

#############################################################################
# country_name(<country to be converted>)
# returns an string for the full name of the country.
#
# Argument: country to display.
# Back: Full state name.
############################################################################
sub country_name {
	my $self = shift;		# Pointer to CGI structure
    my $country = shift;

    return $CountryName{$country};
}

############################################################################
# bindump(<binary data to dump>)
# Will dump out the data as an HTML file
############################################################################
sub bindump {
	my $self = shift;

	my $binary = shift;
	my $max = $#{$binary} + 1;

	print $self->q->header,
		$self->q->start_html('Binary Dump of '.$max.' bytes'),
		$self->q->h1('Binary Dump of '.$max.' bytes');

	print "<br><br><br><br><br><br><br><br><br><br><br><br>";
	print "<TABLE BORDER=\"1\">\n";
	for (my $loop = 0; $loop < $max; $loop += 8)
	{
		print "<TR ALIGN=\"CENTER\" VALIGN=\"TOP\">";
		printf "<TD>%04X</TD>", $loop;
		printf "<TD>%02X</TD>", $binary->[$loop+0] & 0xFF;
		printf "<TD>%02X</TD>", $binary->[$loop+1] & 0xFF;
		printf "<TD>%02X</TD>", $binary->[$loop+2] & 0xFF;
		printf "<TD>%02X</TD>", $binary->[$loop+3] & 0xFF;
		printf "<TD>%02X</TD>", $binary->[$loop+4] & 0xFF;
		printf "<TD>%02X</TD>", $binary->[$loop+5] & 0xFF;
		printf "<TD>%02X</TD>", $binary->[$loop+6] & 0xFF;
		printf "<TD>%02X</TD>", $binary->[$loop+7] & 0xFF;
		print "</TR>\n";
	}
	print "</TABLE>\n";

	print $self->q->end_html;
}


############################################################################
# AUTOLOAD
# if the autoloaded function is a key in the %accessors
# global, we allow simple scalar get/set accessor functions.
#
# otherwise, we see if it's in another global hash or array - these
# are class data which AUTOLOAD provides read-only access to.
############################################################################
sub AUTOLOAD {
	my $self = shift;
	my $arg = shift;
	my $arg2 = shift;

	## need to fix this 'die' to something more polite sometime
	my $type = ref($self) || die "Unexpected error: $self is not an object";

	my $name = $AUTOLOAD;
	$name =~ s/.*://;

	if (exists $accessors{$name}) {
		if (defined $arg) {
			return $self->{$name} = $arg;
		} else {
			return $self->{$name};
		}
	} elsif (defined $arg) {
		no strict "refs";
		if (defined %{$name} && exists($name->{$arg})) {
			return $name->{$arg};
		} elsif ((defined @{$name}) && ($#$name >= $arg)) {
			return $name->[$arg];
		} 
	}
	return undef;
}
#------------------------ EOF --------------------------
1;