#!/bin/perl -w # All rights reserved.
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
# use strict;
use XML::Twig; my $xml_file  = shift @ARGV || "pgc.xml";
my $html_file = shift @ARGV || "pgc_encode.html";
my $var_file  = shift @ARGV || "pgc_vars";
my $desc_file = shift @ARGV || "pgc_desc"; my $id;
my %opt_simple; # list of simple options;
my %opt_level;  # list of range options
my @varlist;    # list of CGI vars in the order they are created
my %desc;       # hash code (item+level) => description my $FILLER= ' 'x4; open( HTML, ">$html_file") or die "cannot create $html_file: $!"; my $t= new XML::Twig( pretty_print => 'indented',
                      empty_tags => 'html',
                      char_handler => sub { $_[0]=~ s/'/'/g; return $_[0];},
                      start_tag_handlers => { item => sub { $id= $_[1]->att( 'id'); } },
                      twig_handlers => {
                        code => \&code,
                       'code/title' => sub { $_[1]->set_gi('h1'); },
                       'modifier[@type="simple"]' => \&simple_modifier,
                       'modifier[@type="level"]' => \&level_modifier,
                       'section'    => sub { $_[1]->set_gi( 'div');
                                             my $hr= new XML::Twig::Elt( 'hr');
                                             $hr->paste( last_child => $_[1]);
                                           },
                       'section/title' => sub { $_[1]->set_gi( 'h2') },
                       'item'      => \&item
                                        }
                   );
$t->parsefile( $xml_file);
$t->print( \*HTML);
close HTML; # now dump the list of variables
open( DUMP, ">$var_file") or die "cannot create $var_file: $!";
print DUMP join "\n", @varlist;
close DUMP; # now dump the descriptions
open( DUMP, ">$desc_file") or die "cannot create $desc_file: $!";
foreach my $field (sort keys %desc)
  { $desc{$field}=~ s/</&lt;/g;
    $desc{$field}=~ tr/\n/ /;
    print DUMP "$field$desc{$field}\n";
  }
close DUMP; sub code
  { my( $t, $code)= @_;
    $code->set_gi( 'html');
    my $body= $code->insert( 'body');
    $body->set_att( bgcolor => "#FFFFFF");
    my $form= $body->insert( 'form');
    $form->set_att( action => '/cgi-bin/pgc/pgc_encode');
    my $version= $code->att( 'version');
    my $version_field= new XML::Twig::Elt( 'input', { type => 'hidden',
                             name => 'version', value => $version});
    $version_field->paste( $form);
    my $submit= new XML::Twig::Elt( 'input', { type => 'submit',
                                               val=> 'compute Perl Geek Code'});
    $submit->paste( 'last_child', $form);
    my $head= new XML::Twig::Elt('head',
               "<title>" . $body->next_elt( 'h1')->text . "</title>");
    $head->paste( $code);
  } sub simple_modifier
  { my( $t, $opt)= @_;
    $opt_simple{$opt->att( 'id')}= $opt->field( 'short');
    $desc{$opt->att( 'id')}= $opt->field( 'long');
    $opt->delete;
  } sub level_modifier
  { my( $t, $opt)= @_;
    $opt_level{$opt->att( 'id')}= $opt->field( 'short');
    $desc{$opt->att( 'id')}= $opt->field( 'long');
    $opt->delete;
  } sub item
  { my( $t, $item)= @_;
    my $title= $item->first_child( 'title');
    $title->move( 'before', $item);
    $title->set_gi( 'h4');
    my $code= $item->att( 'id');
    $desc{$code}= $title->text;
    my @level_str= map { $_->att( 'str'); } $item->children( 'level');
    if( my $subcats= $item->first_child( 'subcats'))
      { # first extract the generic options
        my @generic= $item->get_xpath('level[@generic="yes"]');
        if( @generic)
          { if( scalar @generic == 1)
              { my $generic= shift @generic;
                my $complete_code= $code.$generic->att( 'str');
                my $input= new XML::Twig::Elt( input =>
                             { type => 'checkbox', name => $code,
                               value=> $complete_code},
                             $generic->text);
                push @varlist, $code;
                $desc{$complete_code}= $generic->text;
                $generic->cut;
                my $p= $input->wrap_in( 'p');
                $p->paste( after => $title);
              }
             else
              { my $select= new XML::Twig::Elt( input =>
                             { type => 'select', name => $code});
                push @varlist, $code;
                foreach my $generic (@generic)
                  { my $complete_code= $code.$generic->att( 'str');
                    my $option= new XML::Twig::Elt( option =>
                                  { value => $code},
                                    $complete_code . " " .  $generic->text);
                    $option->paste( last_child => $select);
                    push @varlist, $code;
                    $desc{$complete_code}= $generic->text;
                  }
                my $p= $select->wrap_in( 'p');
                $p->paste( after => $title);
              }
          }
        my @levels= $item->children( 'level');
        my @subcats= $subcats->children( 'subcat');
        my $table= new XML::Twig::Elt( 'table');
        $table->paste( last_child => $item);
        foreach my $subcat (@subcats)
          { my $tr=  new XML::Twig::Elt( 'tr');
           $tr->paste( last_child => $table);
            my $td= $tr->insert( 'td');
            my $id= $subcat->att( 'id');
            my $subcat_title= new XML::Twig::Elt( strong => $subcat->text);
            $subcat_title->paste( last_child => $td);
            $desc{$code.$id}= $subcat->text;
            my $select= new XML::Twig::Elt( select => { name => $code.$id});
            push @varlist, $code.$id;
            foreach my $level (@levels)
              { my $clevel= $level->copy;
                # first replace the replace elements
                my @replace= $clevel->descendants( 'replace');
                foreach my $replace (@replace)
                  { my $val= $replace->att( 'val');
                    if( $val eq 'subcat')
                      { $replace->set_text( $subcat->text); }
                    elsif( $val=~ /^subcat\@([\w]+)$/)
                      { $replace->set_text( $subcat->att( $1)); }
                    else
                      { die "invalid val $val\n"; }
                  }                 # then generate the options
                my $str= $clevel->att( 'str');
                my $complete_code=$code.$id.$str;
                my $long_str= $str . ('&nbsp;' x (6 - length $str));
                my $option= new XML::Twig::Elt( 'option', {value => "$complete_code"},
                                                "$code$id$long_str". $clevel->text);
                $option->paste( last_child => $select);
                $desc{$complete_code}= $clevel->text;
              }
            my $unused= new XML::Twig::Elt( 'option',
                                            {value => "", selected => "selected"},
                                             "------");
            $unused->paste( first_child => $select);
            $td= new XML::Twig::Elt( 'td');
            $td->paste( last_child => $tr);
            $select->paste( $td);
            $td= new XML::Twig::Elt( 'td');
            $td->paste( last_child => $tr);
            add_options( $td, "$code$id", @level_str);
          }
        $subcats->delete;
        $_->delete foreach (@levels);
     } 
    else
      { my @levels= $item->children( 'level');
        my $select= new XML::Twig::Elt( 'select', { name => $code});
        push @varlist, $code;
        foreach my $level (@levels)
          { # generate the options
            my $option= new XML::Twig::Elt( 'option');
            my $str= $level->att( 'str');
            my $complete_code=$code.$str;
            $option->set_att( value => "$complete_code");
            $option->set_att( selected => "selected") unless $str;
            $str.= '&nbsp;' x (6 - length $str);
            $option->set_text( "$code$str". $level->text);
            $option->paste( last_child => $select);
            $desc{$complete_code}= $level->text;
          }
        $select->paste( last_child => $item);
        my $p= new XML::Twig::Elt( 'p');
        $p->paste( last_child => $item);
        add_options( $p, $code, @level_str);
        $_->delete foreach (@levels);
      }
    $item->erase;
  } sub add_options
  { my( $elt, $code, @level_str)= @_;
    my $i=1;
    my $short= ( $elt->gi eq 'td') ? 1 : 0;
    foreach my $opt (keys %opt_level)
      { my( $pref, $suf);
        if( length $opt == 2)
          { ($pref, $suf)= split '', $opt; }
        else
          { ($pref, $suf)= ($opt, ''); }
        my $text= $short ? $opt : "$pref$opt_level{$opt}$suf"; 
        my $q_text= new XML::Twig::Elt( i => "$FILLER$text: ");
        $q_text->paste( last_child => $elt);
        my $select= new XML::Twig::Elt( select => { name => "$code\_mod$i"});
        $select->paste( last_child => $elt);
        push @varlist, "$code\_mod$i";
        my $unused= new XML::Twig::Elt( 'option',
                                        {value => "", selected => "selected"},
                                         "na");
        $unused->paste( first_child => $select);
        foreach my $level (@level_str)
          { my $option= new XML::Twig::Elt( option =>
                                            { value => "$pref$level$suf" },
                                            $pref.$level.$suf);
            $option->paste( last_child => $select);
          }
        $i++;
      }
    foreach my $opt (keys %opt_simple)
      { my $q= new XML::Twig::Elt( input => { type => 'checkbox',
                                              name => "$code\_mod$i",
                                              value  => $opt});
        $q->paste( last_child => $elt);
        push @varlist, "$code\_mod$i";
        my $text= $short ? $opt : ":$opt_simple{$opt} ($opt)$FILLER";
        my $q_text= new XML::Twig::Elt( i => $text);
        $q_text->paste( last_child => $elt);
        $i++;
      }
  }