#!/usr/bin/perl -w

use strict;
use CGI qw/:standard/;

my $verbose=param('verbose') || 0;
my $code1 = param('code1');
my $code2 = param('code2');


print header,
      start_html( -title => "The Perl Geek Code... diffed",
                  -bgcolor => "#FFFFFF"),
      h1( "The Perl Geek Code... diffed"), hr;
print p( strong ( "The Perl Geek Code - Version 0.01"));

unless ($code1 and $code2) {
	print start_form;
	print "Enter your old geek code:" . br;
	print textarea(
		-name => 'code2',
		-rows => 5,
		-cols => 45,
	), p;

	print "Enter your new geek code:" . br;
	print textarea(
		-name => 'code1',
		-rows => 5,
		-cols => 45,
	), p;
	
	print "What output do you want:" . br;
	
	my %options = (
		0 => 'Only tell me what\'s changed.',
		1 => 'Also tell me what hasn\'t changed',
		2 => 'Even remind me what I don\'t get paid for.'
	);
	print popup_menu(
		-name=>'verbose', 
		-values=>[0..2],
		-labels=>\%options,
	),p;
	
	print submit, endform;
	
	exit();
}


$code1=~ s/^\s*-+BEGIN PERL GEEK CODE BLOCK-+\s*\n\s*Version: \d\.\d+\s*\n//;
$code1=~ s/\s*-+END PERL GEEK CODE BLOCK-+\s*$//;

$code2=~ s/^\s*-+BEGIN PERL GEEK CODE BLOCK-+\s*\n\s*Version: \d\.\d+\s*\n//;
$code2=~ s/\s*-+END PERL GEEK CODE BLOCK-+\s*$//;



open( DESC, "<./pgc_desc") or die "cannot open desc file: $!";
my %desc;
#my %desc= map { split /[\t\n]/ } <DESC>;
#I used to say I often try to use map, but as soon as I have a problem in the code I replace it with a foreach but now I say I know the difference between map and grep... in theory. 
foreach (<DESC>) {
	chomp;
	my ($key, $value) = split(/\t/,$_,2);
	$desc{$key} = ($key=~/\W/)
		? '<i>'.$value.'</i>'
		: $value;
}
close DESC;



my %code1 = parseCode( $code1 );
my %code2 = parseCode( $code2 );



# Compare common keys
foreach my $key ( sort keys %code1 ) {

	# do individuals last
	next unless $code2{$key}; 

	# dont talk if they match
	if ($code1{$key}{code} eq $code2{$key}{code}) {
		if ($verbose) {
			print '<h3>'.$desc{$key}."</h3>\n";
			printf("Code: <tt>%s</tt>",$code2{$key}{code});
			print "<br>\n";
			if($code1{$key}{range}){ 
				printf("My tendencies still range from %s to %s. ", 
					$desc{$key.$code2{$key}{level}},
					$desc{$key.$code2{$key}{range}}
				);
			} else {
				print "I still say " . $desc{$key.$code1{$key}{level}} . '. ';
			}
			
			my $paid = ($code1{$key}{'paid'})
				? "I get paid for it. "
				: ($verbose > 1)
					? "I don't get paid for it. "
					: '';
			print $paid;
			
			print "I'd like to be able to say " .
				$desc{$key.$code2{$key}{wannabe}} . '. ' if $code2{$key}{wannabe};					
		}
		delete $code1{$key};
		delete $code2{$key};
		next;
	}
	
	# otherwise compare them
	
    print '<h3>'.$desc{$key}."</h3>\n";
	printf("Old: <tt>%s</tt>   New: <tt>%s</tt>",$code2{$key}{code}, $code1{$key}{code});
    print "<br>\n";
    
    # compare the levels
    unless (
    	$code1{$key}{range} eq $code2{$key}{range}
    	and
    	$code1{$key}{level} eq $code2{$key}{level}
	) {
			
		if($code2{$key}{range}){ 
			printf("My tendencies used to range from %s to %s", 
				$desc{$key.$code2{$key}{level}},
				$desc{$key.$code2{$key}{range}}
			);
		} else {
			print "I used to say " . $desc{$key.$code2{$key}{level}};
		}
		
		print " but now I say ";	
		
		if($code1{$key}{range}){ 
			printf("my tendencies range from %s to %s. ", 
				$desc{$key.$code2{$key}{level}},
				$desc{$key.$code2{$key}{range}}
			);
		} else {
			print $desc{$key.$code1{$key}{level}} . '. ';
		}
	} elsif ($verbose) {
		if($code1{$key}{range}){ 
			printf("My tendencies still range from %s to %s. ", 
				$desc{$key.$code2{$key}{level}},
				$desc{$key.$code2{$key}{range}}
			);
		} else {
			print "I still say " . $desc{$key.$code1{$key}{level}} . '. ';
		}
	}
	
	unless ($code1{$key}{wannabe} eq $code2{$key}{wannabe}) {
		if ($code1{$key}{wannabe} and not $code2{$key}{wannabe}) {
			print "I used to attain to nothing but now I wish I could say " . 
				$desc{$key.$code1{$key}{wannabe}} . '. ';
		} elsif ($code2{$key}{wannabe} and not $code1{$key}{wannabe}) {
			if (level2num($code1{$key}{level}) > level2num($code2{$key}{wannabe})) {
				print "My old ambition of being able to say " .
					$desc{$key.$code2{$key}{wannabe}} . 
					" has been attained as " . $desc{$key.$code1{$key}{level}} . '. ';
			} elsif (level2num($code1{$key}{level}) == level2num($code2{$key}{wannabe})) {
				print "My old ambition of being able to say " .
					$desc{$key.$code2{$key}{wannabe}} . 
					" has been attained. ";
			} else {
				print "I used to want to be able to say " . 
					$desc{$key.$code2{$key}{wannabe}} . 
					", but I lost that ambition. ";
			}
		} else {
			print "I used to want to be able to say " . 
				$desc{$key.$code2{$key}{wannabe}} . 
				" but now I say " .
				$desc{$key.$code1{$key}{wannabe}} . '. ';
		}
	
	} elsif ($verbose and $code2{$key}{wannabe}) {
		print "I'd still like to be able to say " .
			$desc{$key.$code2{$key}{wannabe}} . '. ';
	
	}
	
	unless ($code1{$key}{paid} eq $code2{$key}{paid}) {
		if ($code1{$key}{paid} and not $code2{$key}{paid}) {
			print "I now get paid for it. "
		} elsif ($code2{$key}{paid} and not $code1{$key}{paid}) {
			print "I no longer get paid for it. "
		} else {
			printf("Something weird happened to the paid code: [%s] [%s]. ",
				$code1{$key}{paid}, $code2{$key}{paid});
			
		}
	} elsif ($verbose and $code1{$key}{paid}) {
		print "I still get paid for it."
	} elsif ($verbose > 1 and not $code1{$key}{paid}) {
		print "I still don't get paid for it."
	}
	
	
	print "<p>\n\n";
	
	delete($code1{$key});
	delete($code2{$key});
}

# Report on new tags
foreach my $key ( sort keys %code1 ) {
	next unless $code1{$key}{code};
    print '<h3>'.$desc{$key}."</h3>\n";
	printf("New: <tt>%s</tt>",$code1{$key}{code});
    print "<br>\n";
	print "I now say " . $desc{$key.$code1{$key}{level}} . '. ';	
	print "I get paid for it. " if $code1{$key}{paid};
	print "I wish I could say " . $desc{$key.$code1{$key}{wannabe}} if $code1{$key}{wannabe};	
}
# Report on forgotten tags
foreach my $key ( sort keys %code2 ) {
	next unless $code2{$key}{code};
    print '<h3>'.$desc{$key}."</h3>\n";
	printf("Old: <tt>%s</tt>",$code2{$key}{code});
    print "<br>\n";
	print "I no longer say " . $desc{$key.$code2{$key}{level}} . '. ';	
	print "So I no longer get paid for it. " if $code2{$key}{paid};
	print "And I've stopped wishing I could say " . $desc{$key.$code2{$key}{wannabe}} if $code2{$key}{wannabe};	
}







sub parseCode {
	my $code = shift;
	return () unless $code;
	
	my %return;

	foreach my $segment ( $code =~ m{(\w+\W*)}g ){
		
		$segment=~s/\s+/ /gs;
		$segment=~s/(\W)\s+$/$1/gs;
#		warn $segment;
		
		my @thiscode = $segment =~ m{((\w+)              # the item         $2
			([*!? +-]+)           # the level        $3
			(?:\>([*!? +-]+))?    # optional >level  $4
			(?:\(([*! ?+-]+)\))?  # optional (level) $5
			(\@)?                 # optional @       $6
			(\$)? )               # optional $       $7
		}x;
		
		$segment =~ s/\@//g; # varies doesn't work yet
	
		die("Unable to parse $segment in $code") unless $thiscode[1];
	
		$return{$thiscode[1]} = {
			level   => $thiscode[2] || '',
			wannabe => $thiscode[3] || '',
			range   => $thiscode[4] || '',
			varies  => $thiscode[5] || '',
			paid    => $thiscode[6] || '',
			code	=> $thiscode[0] || '',
		};

	}
	return %return;
}					

sub level2num {
	my $level = shift;
	return 0 if $level eq ' ';
	return ($level=~/\-/) 
		? -1 * length($level)
		: length ($level);
}