#!/usr/bin/perl

# unpp.pl -- Decoder for "!Impressions! Web Design PageParser v1.1"
#            (fancier version)
#
# Copyright (c) 1997, Devin Carraway <aqua@sonoma.net>
#
# Freely redistributable under terms of the GNU Public License.
#
# Works with (against?) PageParser v1.1; at the moment it merely replicates
# in perl what PP does in JavaScript (albeit much quicker, owing to the
# relative optimizations of the languages), making some guesses as to what
# string literals contain the decoder lookup table and the page data.
#
# A tiny attempt to retain HTML as an open format; if you don't want anyone
# to see your code, don't expect anyone to run it.
#

require 5;
use strict;

use URI::Escape;

my $buf = join("\n",<>);
my (@sbuf,$x);

while ($buf =~ m/[A-Za-z_]\w*\s*=\s*"([^"]*)"[\t\f ]*[;,\n]?/g) {
  my $x = $1;
  push @sbuf, $x unless ($x =~ /^javascript$/i);
}

my $filter = $sbuf[0];
my $data = $sbuf[$#sbuf];

my $activelen = length($data);
$activelen = 500 unless $activelen<500;

my $rbuf = substr($data,$activelen);
my $cbuf = '';


my @scbuf = split(//,substr($data,0,$activelen));
my @fcbuf = split(//,$filter);
my ($i,$i1,$sindex) = (0,0,0);

for ($i=0; $i<=$#scbuf; $i++) {
  for ($i1=0,$sindex=-1; $i1<=$#fcbuf; $i1++) {
    ($sindex = $i1), last if ($fcbuf[$i1] eq $scbuf[$i]);
  }
  if ($sindex!=-1 && $fcbuf[$sindex^3] eq 'A' || $fcbuf[$sindex^3] eq 'c') {
    print "";
  }
  $cbuf .= (($sindex!=-1)?($fcbuf[$sindex ^ 3]):$scbuf[$i]);
}

$buf = uri_unescape($cbuf.$rbuf);

#print $buf;

$*=1;

$buf = &hb($buf);

$buf =~ s/(<script[^>]*>)(.*?)(<\/script[^>]*>)/$1.&jb($2).$3/gie;

print $buf;

sub jb {
# JavaScript beautifier (except intendation; js_indent does that)
  my ($dat) = @_;

  # Strip /* */-style comments (by Jeffrey Freidl*; stolen from the perl5 FAQ)
  $dat =~ s#/\*[^*]*\*+([^/*][^*]*\*+)*/|([^/"']*("[^"\\]*(\\[\d\D][^"\\]*)*"[^/"']*|'[^'\\]*(\\[\d\D][^'\\]*)*'[^/"']*|/+[^*/][^/"']*)*)#$2#g;
  # assume function definitions to be SOLs
  $dat =~ s/function/\nfunction/gi;
  # assume semicolons to be EOLs (for (*; *; *) to be handled later)
  $dat =~ s/;/;\n/g;
  # assume { to imply EOLs unless followed by else or while
  $dat =~ s/\{\s*(?!else|while)/\{\n/g;
  # ){ to ) {
  $dat =~ s/\)\{/\) \{/g;
  # Adjust whitespace for loop/conditional start
  $dat =~ s/(if|while|for)\(/$1 \(/g;
  # fix if-else middle
  $dat =~ s/(\})\s*else\s*(\s*\{)/$1 else $2\n/g;
  # fix do-while end
  $dat =~ s/\}\s*while\s+/\} while /g;
  # fix for (;;) start
  $dat =~ s/for\s*\(\s*([^;]*)\s*;\s*([^;]*)\s*;\s*([^;]*)\s*\)\s*(\{)/for \($1; $2; $3\) $4/g;
  # Fix globs following { ... } scopes
  $dat =~ s/(\S)\}/$1\n\}/g;
  $dat =~ s/\}([^\s;])/\}\n$1/g;
  $dat =~ s/\};/\}/g;
  return &js_indent($dat);
}

sub hb {
# Simple-minded HTML beautifier; takes messy agglomerations of HTML
# and makes messy but marginally more readable HTML.  Minimal indentation.
  my ($dat) = @_;
  my ($nm) = $*;

  $* = 1;
  $dat =~ s/<(html)>/\n<$1>\n/gi;
  $dat =~ s/<(\/?)(body|head|)>/\t<$1$2>\n/gi;
  $dat =~ s/<(title)>(.*?)<(\/title)>/\t<$1>$2<$3>\n/gi;
  $dat =~ s/<(\/?)(script|center)>/<$1$2>\n/gi;
  $dat =~ s/<(\/?)(body|form|table|tr|td|th)([^>]*)>/<$1$2$3>\n/gi;
  $dat =~ s/<(\/?)(br|p|hr)>/<$1$2>\n/gi;
  $dat =~ s/(?!\n)$/\n/;
  $* = $nm;
  return $dat;
}

# Shamelessly stolen rom 'pb' - perl beautifier; changed to handle input
# from a glob in @_, return parsed glob, also moved vars &c to make it work
# with Perl5 and use-strict.
# Otherwise original code by P. Lutus <lutusp@arachnoid.com>
sub js_indent {
  my @infa = split(/\n/,$_[0]);
  my ($a,$q,$i,$delta,$outq,$tabtotal,$tabstring);

  $tabstring = "\t";

  for (@infa) {
    
    s/^\s*(.*?)\s*$/$1/; # strip leading and trailing spaces
    
    $a = $_; # copy original string
    $q = $a; # i plan to modify this copy for testing
    $q =~ s/\\\#//g; # remove escaped comment tokens
    $q =~ s/\#.*?$//g; # remove Perl-style comments
    $q =~ s{/\*.*?\*/} []gsx; # remove C-style comments
    $q =~ s/\\\{//g; # remove escaped left  braces
    $q =~ s/\\\}//g; # remove escaped right braces
    $q =~ s/\\\(//g; # remove escaped left  parentheses
    $q =~ s/\\\)//g; # remove escaped right parentheses
    
    $q =~ s/\'.*?\'//g; # remove single-quoted lines
    
# now the remaining braces/parentheses should be structural
    
    $delta = -($q =~ s/\}/\}/g); # subtract closing braces
    $delta += ($q =~ s/\{/\{/g); # add opening braces
    
    $delta -= ($q =~ s/\)/\)/g); # subtract closing parens
    $delta += ($q =~ s/\(/\(/g); # add opening parens
    
    $tabtotal += ($delta < 0)?$delta:0; # subtract closing braces/parentheses
    $i = ($tabtotal > 0)?$tabtotal:0; # create tab index
    $tabtotal += ($delta>0)?$delta:0; # add opening braces/parentheses for next print
    $outq .= ($tabstring x $i); # "tab" out to position
    $outq .= "$a\n"; # print original line

  } # -- for (@infa)
  
  return $outq;  
} # sub process