#!/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/</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',
"
" . $body->next_elt( 'h1')->text . "");
$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 . (' ' 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.= ' ' 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++;
}
}