#!/usr/bin/perl -w
use CGI;
use CGI::Carp qw(fatalsToBrowser);

#do our reserved words

##################################################
#C++
##reserved variable types
  $WORDS{cpp}{int} = "blue";
  $WORDS{cpp}{void} = "blue";
  $WORDS{cpp}{char} = "blue";
  $WORDS{cpp}{bool} = "blue";
  $WORDS{cpp}{double} = "blue";
  $WORDS{cpp}{long} = "blue";
  $WORDS{cpp}{short} = "blue";
  $WORDS{cpp}{unsigned} = "blue";
  $WORDS{cpp}{__cecdl} = "blue";

##reserved words
  $WORDS{cpp}{if} = "blue";
  $WORDS{cpp}{else} = "blue";
  $WORDS{cpp}{while} = "blue";
  $WORDS{cpp}{for} = "blue";
  $WORDS{cpp}{static} = "blue";
  $WORDS{cpp}{const} = "blue";
  $WORDS{cpp}{using} = "blue";
  $WORDS{cpp}{lvoid} = "blue";
  $WORDS{cpp}{new} = "blue";
  $WORDS{cpp}{delete} = "blue";
  $WORDS{cpp}{return} = "blue";
  $WORDS{cpp}{namespace} = "blue";
  $WORDS{cpp}{__asm} = "blue";

##reserved variables
  $WORDS{cpp}{NULL} = "purple";

##preprocessor definitions
  $WORDS{cpp}{include} = "blue";
  $WORDS{cpp}{define} = "blue";
  $WORDS{cpp}{undef} = "blue";
  $WORDS{cpp}{ifdef} = "blue";
  $WORDS{cpp}{ifundef} = "blue";
  $WORDS{cpp}{endif} = "blue";
  $WORDS{cpp}{pragma} = "blue";


##################################################
#Perl
##reserved variable types

##reserved words
  $WORDS{pl}{for} = "blue";
  $WORDS{pl}{shift} = "blue";
  $WORDS{pl}{foreach} = "blue";
  $WORDS{pl}{while} = "blue";
  $WORDS{pl}{if} = "blue";
  $WORDS{pl}{elsif} = "blue";
  $WORDS{pl}{else} = "blue";
  $WORDS{pl}{'$'} = "0A0A0A"; #context
  $WORDS{pl}{'@'} = "0A0A0A";
  $WORDS{pl}{'%'} = "0A0A0A";
  $WORDS{pl}{'$!'} = "0A0A0A"; #internal variables
  $WORDS{pl}{'@ARGV'} = "0A0A0A";
  $WORDS{pl}{'$$'} = "0A0A0A";
  $WORDS{pl}{'@$'} = "0A0A0A";
 

##preprocessor definitions
  $WORDS{pl}{'=head'} = "blue";
  $WORDS{pl}{__END__} = "blue";


##other
  $WORDS{pl}{my} = "blue";
  $WORDS{pl}{local} = "blue";
  $WORDS{pl}{return} = "blue";
  $WORDS{pl}{sub} = "blue";
  $WORDS{pl}{warn} = "orange";
  $WORDS{pl}{die} = "purple";
  $WORDS{pl}{or} = "blue";
  $WORDS{pl}{OR} = "blue";

##################################################
#CSS
##reserved variable types

##reserved words
  $WORDS{css}{body} = "purple";
    $WORDS{css}{background-image} = "blue";	#these are valid _inside_ body tag.
    $WORDS{css}{background-repeat} = "blue";
    $WORDS{css}{background-position} = "blue";
    $WORDS{css}{background-color} = "blue"; 



%SLC = qw{ c // cpp // css // };	#single-line-comment

push( @{$MLC{c}},	'/*' );		#multi-line-comment
push( @{$MLC{c}},	'*/' );
push( @{$MLC{cpp}},	'/*' );
push( @{$MLC{cpp}},	'*/' );
push( @{$MLC{css}},	'/*' );
push( @{$MLC{css}},	'*/' );

$CC{c} = "green";		#comment color
$CC{cpp} = "green";
$CC{css} = "green";


#Polarstate - Global Midnight (martin roth remix) --very good
#Kuffdam and Plant - Summer Dream (original mix) --not that awesome, but its kuffdam.










$CGI = new CGI;

print $CGI->header;
print $CGI->start_html(-TITLE=>'CodeViewer.pl (c) Charles A. Morris 2005', -BGCOLOR=>'F0F0F0', -FONT=>{'face'=>'courier'});

print $CGI->startform;

if ($CGI->param('path'))
{
  $file = $CGI->param('path');
  @f = split(/\./, $file);
  $ext = $f[(scalar(@f)-1)];
  if ($ext eq 'h'){$ext = 'c';} #too bad for somebody who uses a language that ends in .h ! lol!

#  local( $/, *HDL);
#  open(HDL, $file ) or die "perlploded! $!\n";
#  while($content .= <HDL>){}
#  close(HDL);

  $content = qx{/bin/cat $file}; #LOL!!!!111

  #these regexp splits on stuff that we dont care about (keep vars, endlines) [maybe we want to just do whitespace...]
  @{$regexp{c}}[0] = '[^A-Za-z0-9_-]+';
  @{$regexp{c}}[1] = '[A-Za-z0-9_-]+';
  @{$regexp{cpp}}[0] = '[^A-Za-z0-9_-]+';
  @{$regexp{cpp}}[1] = '[A-Za-z0-9_-]+';
  @{$regexp{perl}}[0] = '[^A-Za-z0-9_-%$@]+';
  @{$regexp{perl}}[1] = '[A-Za-z0-9_-%$@]+';
  @{$regexp{css}}[0] = '[^A-Za-z0-9_-]+';
  @{$regexp{css}}[1] = '[A-Za-z0-9_-]+';

#print "Config:<BR>\n";	#uncomment for d3bug
#print "chosen regexp: /@{$regexp{$ext}}[0]/ & /@{$regexp{$ext}}[1]/<BR>\n";
#print "1) \$word eq " . $SLC{$ext} . "<BR>\n";
#print "2) \$word eq " . @{$MLC{$ext}}[0] . "<BR>\n";
#print "3) \$word eq " . @{$MLC{$ext}}[1] . "<BR>\n";
#print "4) \$word is endline<BR>\n";
#print "5) \$word is colorized<BR>\n";
#print "<BR>\n";

  @words = split(/@{$regexp{$ext}}[0]/, $content); #bugfix by Ian, sucks, but mine is hard to implement.
  @space = split(/@{$regexp{$ext}}[1]/, $content); #this is so bizarre... yeah..... whatever.

  foreach $word (@words)
  {
    $spacer = &translateToHTML($space[$offset]);

    if ( $word eq $SLC{$ext} ) # //
    {
      if ($inside_slc == 0)
      {
        print "<FONT face='courier' color='". $CC{$ext} ."'>"; # CC is comment color
        $inside_slc = 1;
      }
    print $word . $spacer; #christ, so newbish
    }
    elsif ( $word eq @{$MLC{$ext}}[0] ) # /*
    {
      if ( $inside_mlc == 0 )
      {
        print "<FONT face='courier' color='". $CC{$ext} ."'>"; # CC is comment color
      }
    print $word . $spacer;
    }
    elsif ( $word eq @{$MLC{$ext}}[1] ) # */
    {
      if ( $inside_mlc == 1 )
      {
        print "</FONT>";
        $inside_mlc = 0; #MLCs are terminated only by MLC ending sequence
      }
      print "<FONT face='courier'>$word$spacer</FONT>";
    }
    elsif ( $word eq "\n" || $word eq "\r" )
    {
      if ($inside_slc == 1)
      {
        print "</FONT>";
        $inside_slc = 0; #SLCs are terminated at every end-of-line
      }
      print "<BR>"; #(for page output)
      print "\n"; #(for source output)
    }
    elsif ( $WORDS{$ext}{$word} ne '' ) #if its defined as having a color
    {
      print "<FONT face='courier' color='" . $WORDS{$ext}{$word} . "'>" . $word . "</FONT>" . $spacer; #spacer after font tag
    }
    else
    {
      print "<FONT face='courier'>" . $word . $spacer . "</FONT>";
    }
  $offset++;
  }
}

print $CGI->endform;

# this takes in a slurp of weird shit, converts in into super-happy-fun readable format.
sub translateToHTML()
{
  my $string = shift;

  my @chars = split(//, $string);

  my ($char, $out);

  
  foreach $char (@chars)
  {
    if ($char eq "\n" || $char eq "\r"){ if($lastCharWasEndline == 0){$char = "<BR>\n";}$lastCharWasEndline = 1;} #DAMN WINDOWS!! DAMN IT!! (lCWE = 1)
    elsif ($char eq ' '){ $char = '&nbsp'; $lastCharWasEndline = 0;}
    elsif ($char eq "\t"){ $char = '&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp&nbsp'; $lastCharWasEndline = 0;}
    elsif ($char eq '<'){ $char = "&lt"; $lastCharWasEndline = 0;}
    elsif ($char eq '>'){ $char = "&gt"; $lastCharWasEndline = 0;}
    else{ $lastCharWasEndline = 0;}
    $out .= $char;
  }

return $out;
}