use strict; # use warnings; # use diagnostics; use HTML::Parser; use CGI_Lite; my ($prog, $inpre, $inprog, $intitle, $inxplain, $xplain, $title); my $p = HTML::Parser->new( api_version => 3, start_h => [\&start, "tagname, attr"], end_h => [\&end, "tagname"], text_h => [ \&text, "dtext" ], marked_sections => 1, ); my $dir = '/web/www.stonehenge.com/merlyn/WebTechniques'; # I shoved them here my $idx; # content of the index for my $nr ( '01' .. '67' ) { my %ln; # memorize spans $xplain = $prog = $title = ''; my ($fsfnm, $progfnm, $xplainfnm ) = map { "$dir/col$nr$_.html" } qw( fs prog xplain ); my $fnm = "$dir/col$nr.html"; die "can't find file $fnm" unless $p->parse_file("$fnm"); my $js = < var previd = 0; function hilite(id ) { if ( previd != 0 ) { top.frames[1].document.getElementById(previd).style.color = 'black' ; } previd = id; top.frames[1].document.getElementById(id).style.color = 'red' ; } EOF my $head = "$title"; my $fshead = "$title"; my $tail = "\n"; my $fstail ="\n"; my $fs =qq| you are not framed! |; # gathering line references coping with their style inconstency $xplain =~ s((lines?\s+(\d+)(\s*(through|thru|to|-|and)\s*(?:line\s+)?(\d+))?)) ( $ln{"$2_$5"}++; genhilite($1, "$2_$5", $nr) )eig; $xplain =~ s(

.*?Listings.*?

)()s; # supress listing left-over for (keys %ln ) { # the massage is the message my ($from, $to ) = $_; # print STDERR "$from -> $to\n"; ($from, $to) = m/(\d+)_(\d*)/; if ($to) { $prog =~ s((?-s)(=$from=.*(?s).*?=$to=(?-s).*)) ($1); # the first (?-s) should not be necessary } else { $prog =~ s((=$from=.*)) ($1); } } open O, ">$fsfnm" or die $@; print O $fshead, $fs, $fstail; open O, ">$xplainfnm" or die $@; print O $head, $js, $xplain, $tail; open O, ">$progfnm" or die $@; print O $head, "
\n", $prog, "
", $tail; $idx .= qq|
  • $title
    • |; } $idx = "Framing Merlyn"; open O, ">$dir/index.html"; print O $idx; sub genhilite($$$) { my ( $str, $span, $nr) = @_; qq($str) ; } sub attr2str { my ( $attr ) = @_; my $str; $str .=" $_='$attr->{$_}'" for sort keys %$attr ; $str; } sub start { my ( $tagnm, $attr) = @_; $inpre = 1 if $tagnm eq 'pre'; $intitle = 1 if $tagnm eq 'title'; $xplain .= "<$tagnm" . attr2str($attr) .">" if $inxplain; $inxplain = 1 if $tagnm eq 'body'; } sub end { my ( $tagnm) = @_; $inprog = $inpre = 0 if $tagnm eq 'pre'; $intitle = 0 if $tagnm eq 'title'; $inxplain = 0 if $tagnm eq 'body'; $xplain .= "" if $inxplain; } sub text { my ( $dtxt ) = @_; $inprog = $inpre && $dtxt =~ m/=\d+=/; $dtxt = browser_escape( $dtxt) if $inpre; if ( $inprog) { $prog .= $dtxt; } elsif ( $intitle) { $title .= $dtxt; } else { $xplain .= $dtxt if $inxplain; } }