#!/usr/bin/perl -w

my ($image, $h, $w)=&load_ppm($ARGV[0]);
my $s=3*$h*$w;
my @A=unpack("C$s", $image);
my $l="AnREaHTtEePZahPZcarJsWPZ";
my $p=0;
my $i;
$l=~tr/PoZuTsEcRalnAeJhMHktrW/eMrEnctls ZuJhaPTARoHk/;
for($i=0; $i<$s-3; $i++) {
  if(chr($A[$i]) eq substr($l, $p%24, 1)) {
    my $i=$i - $i%3;
    print substr($l, $p%24, 1); #chr($l[$p]);
    $p++;
    $A[$i] = $A[$i]>127?0:255; $i++;
    $A[$i] = $A[$i]>127?0:255; $i++;
    $A[$i] = $A[$i]>127?0:255;
  }
}
printf "\nThis is a %d-hacker!\nPerl is %.2f%% of his personality\n", 
  int($p/24), 100*$p/$s*3*24;

if ($ARGV[1]) {
  $image = pack("C$s", @A);
  &write_ppm($ARGV[1], $image, $h, $w);
}

0;

# Thanks to Corion,jcwren,tilly
sub load_ppm {
  my $name=shift || die;
  my $image;
  open(F, "<$name") || die;
  $_=<F>;
  die "$name is not a PPM file, (header=$_)\n" unless($_ eq "P6\n");
  do { $_=<F> } while ( m/^\#/ );    # skip comments
  my ($w, $h) = m/(\d+)\D+(\d+)/;
  $_=<F>;
  die "Can't deal with this type of PPM\n" unless ($_==255);
  binmode(F);			# just in case
  $_=read(F, $image, 3*$h*$w) or die;
  close(F);
  return ($image, $h, $w);
}

sub write_ppm {
  my ($name, $image, $h, $w) = @_;
  open(F, ">$name") or die;
  binmode F;
  $_=sprintf "P6\n$w $h\n255\n";
  print F "$_$image";
  close(F);
}