#!/usr/local/bin/perl -w # Produce Files from Templates using wwwalias for aliases # makeform OPTIONS # # Recognize following special commands on style file specified as filename:XXXX # in OPTIONS input # {title} {titlesize} {baretitle} {rest} {restsize} # {family} {childfamily} {world} {view} {path} {multimedia} {style} {urlstem} {search} # {addon} {slaveversion} # {select} # {childurls} # &readalias("wwwalias"); &readalias("javaalias"); # # # Set Template Command Variables $classwww{"select"} = 3; $classwww{"view"} = 1; $classwww{"path"} = 1; $classwww{"title"} = 2; $classwww{"baretitle"} = 2; $classwww{"titlesize"} = 2; $classwww{"rest"} = 2; $classwww{"restsize"} = 2; $classwww{"family"} = 2; $classwww{"childfamily"} = 2; $classwww{"slaveversion"} = 2; $classwww{"body"} = 2; $classwww{"urlstem"} = 2; $classwww{"search"} = 2; $classwww{"world"} = 2; $classwww{"multimedia"} = 2; $classwww{"addon"} = 2; $classwww{"style"} = 2; $classwww{"childurls"} = 4; $aliasnotsimple=0; # %procoptvocab = ( "filename",0,"title",0,"rest",0,"restfile",0,"family",0,"childfamily",0,"world",0,"style",0,"multimedia",0,"urlstem",0,"search",0,"baretitle",0,"addon",0,"slaveversion",0, "view",1,"path",1,"target",0,"template",0, "contd",0, "html",0,"endhtml",0); # &readopt($ARGV[0]); # # End main routine # sub readalias { # Read alias file # my($file)=@_; # my($fullline); # open(ALIAS,$file) || die("Sorry Couldnt read ALIAS ",$fullline," \n"); while($fullline=) { chomp($fullline); &alias_decode('',$fullline); } close(ALIAS); &alias_cleanup; } # sub alias_decode { # Decode alias definition # key is EITHER in first argument or in first entry in value1@value2@ .. # string transmitted as second argument # if key is alias assume next entry in string is real key! # my($key,$line)=@_; my(@fields,$test); # @fields=split(/@/,$line); $test=$fields[0]; $test =~ tr/A-Z/a-z/; shift(@fields) if($test eq 'alias'); $key=shift(@fields) unless $key; $key=shift(@fields) if $key eq 'alias'; # $wwwalias_url{$key}=$fields[0]; if($fields[1]) { $wwwalias_title{$key}=&tohtml($fields[1]); $wwwalias_titlegiven{$key}=1; } else { $wwwalias_title{$key}='At location ' . &tohtml($fields[0]); $wwwalias_titlegiven{$key}=0; } # $wwwalias_comment{$key}= &tohtml($fields[2]); # $wwwalias_author{$key}= &tohtml($fields[3]); # $wwwalias_date{$key}= &tohtml($fields[4]); # } # End alias_decode # sub alias_cleanup { # my($name,$replace); # foreach $name (keys %wwwalias_url) { next if $wwwalias_url{$name} =~ /^JAVASCRIPT/; $changed_alias=1; $replace=$wwwalias_url{$name}; while( $changed_alias) { $changed_alias=0; $replace=&alias_subst($replace); } $wwwalias_url{$name}=$replace; } } # End alias_cleanup # sub alias_subst { # my($total,$firsttag); # $end_alias=$_[0]; $total=""; while($end_alias) { if(&aliascurlyscan($end_alias)) { $total .= $begin_alias; if( $full=$wwwalias_url{$tag_alias} ) { if( $full =~ m%^JAVASCRIPT$% ) { $firsttag =''; $firsttag = '\'' . $string_alias . ''; } else { $total .= $full; } ++$changed_alias; } } else { $total .= '{' . $tag_alias . '}'; } next; } else { $total .= $begin_alias; last; } } # End loop over curly brackets return $total; # } # End alias_subst # sub aliasroundbracket { # $end_alias=$_[0]; if( $end_alias =~ m%^\\\(% ) { $end_alias =~ s/^.//; return 0; } if( $end_alias =~ m%^\(([^\(\)]*)\)(.*)% ) { $string_alias= $1; $end_alias=$2; return 1; } return 0; # } # End aliasroundbracket # sub aliascurlyscan { # my($inline)=@_; my($line); # $line=$inline; $begin_alias=''; while($line) { # if( $line =~ m%([^{]*){([^}]*)}(.*)% ) { if( $1 =~ m%\\$% ) { $begin_alias .= $1 . '{'; $line = $2.'}'.$3; next; } $begin_alias .= $1; $end_alias=$3; $tag_alias=$2; $tag_alias =~ s/\s*//g; return 1; } $begin_alias=$inline; $end_alias=''; $tag_alias=''; return 0; } # End loop over starting { $begin_alias=$inline; return 0; # } # End alias curly scan # # read dictionary from PROCOPTIONS sub readopt { # my($procfile)=@_; my($curkey,$vocabmem,$reading_html,$colon,$possiblekey,$savekey,$entry,$rest,$line); # open(PROCOPTIONS,$procfile) || die("\nSorry couldnt Open Procoptions ",$procfile, "\n"); # $reading_html=0; # Initial HTML option undef %optionvalues; $optionvalues{'filename'}='NULL'; # # $curkey='none'; while( $line= ) { chomp($line); $colon = index($line,":"); if ( ($line =~ /^\s/) || $colon < 0 ) { die("\nIllegal Continuation Line", $rest,"\n") if $curkey eq 'none'; $line =~ s/^\s+/ /; $optionvalues{$curkey} = &join($optionvalues{$curkey},$line); next; } $possiblekey = substr($line ,0, $colon); $possiblekey =~ s/\s+//g; $savekey=$possiblekey; $possiblekey =~ tr/A-Z/a-z/; &procname() if($possiblekey eq 'filename'); $entry = -1; foreach $vocabmem (keys %procoptvocab) { if( $possiblekey eq $vocabmem ) { $entry = $procoptvocab{$vocabmem}; last; } } if( $entry < 0 ) { die("\nIllegal key Processing Options ", $possiblekey, "\n"); } if( $possiblekey eq "html" ) { $reading_html=1; next; } if( $possiblekey eq "endhtml" ) { $reading_html=0; next; } $rest = substr($line, $colon+1); if( $possiblekey eq "contd" ) { if ($curkey eq 'none') { die("\nIllegal Continuation Line", $rest,"\n"); } if( $savekey eq "CONTD" ) { $optionvalues{$curkey} .= "\n" . $rest; next; } $optionvalues{$curkey} = &join($optionvalues{$curkey},$rest); next; } if( $entry == 1 ) { if( defined($optionvalues{$possiblekey}) ) { $count = ++$optioncount{$possiblekey}; $optionarray[$count-1]{$possiblekey} = $optionvalues{$possiblekey}; $optionarray_html[$count-1]{$possiblekey} = $optionvalues_html{$possiblekey}; } else { $optioncount{$possiblekey}=0; } } $optionvalues{$possiblekey} = $rest; $optionvalues_html{$possiblekey} = $reading_html; $curkey=$possiblekey; } # End loop over input lines # &procname; close(PROCOPTIONS); # # return; # } # end readopt sub procname { # Process shortcode # my($key,$line,$title,$titlesize,$restline,$getfromfile,$locallasti,@localdata,$restsize,$family,$childfamily,$world,$style,$multimedia,$slaveversion,$body,$urlstem,$search,$baretitle,$addon,$view,$path,$realfile,$i,$testwww,$lineacc,$grab,$vocabmem); # return if ($key=$optionvalues{'filename'}) eq 'NULL'; # foreach $vocabmem (keys %procoptvocab) { next unless $procoptvocab{$vocabmem}==1; if( defined($optionvalues{$vocabmem}) ) { $count = ++$optioncount{$vocabmem}; $optionarray[$count-1]{$vocabmem} = $optionvalues{$vocabmem}; $optionarray_html[$count-1]{$vocabmem} = $optionvalues_html{$vocabmem}; } else { $optioncount{$vocabmem}=0; } } # # if $target defined we are probably processing an index! $aliasnotsimple=1; $aliasnotsimple = 0 if( $key =~ 'imple' ); $target= $optionvalues{'target'}; $target= '' unless(defined($target)); if( $target ) { $aliasnotsimple = 0; $target=' target="' . $target . '" '; } # $title = $optionvalues{'title'}; $baretitle = $title; $title = &protectquote($title); $title = &tohtml($title) unless $optionvalues_html{'title'}; $titlesize = &setcharactersize($title,$optionvalues_html{'title'},''); $restline= $optionvalues{'rest'}; $restlinehtml = 0; if(defined($restline)) { $restline = &tohtml($line) unless $optionvalues_html{'rest'}; $restline = &alias_subst($restline); $restlinehtml = $optionvalues_html{'rest'}; } else { $restline =''; } $getfromfile = $optionvalues{'restfile'}; if(defined($getfromfile)) { $restlinehtml = $optionvalues_html{'restfile'}; open(INFILE,"<".$getfromfile) || die("\nSorry couldn't open ",$getfromfile,"\n"); @localdata=; $locallasti=@localdata; close(INFILE); for( $i=0; $i < $locallasti; $i++ ) { $line=$localdata[$i]; chomp($line); $line = &tohtml($line) unless $optionvalues_html{'restfile'}; $line = &alias_subst($line); $restline .= "\n" if($restline); $restline .= $line; } } # # Process link commands $linkset=0; $rest = &analyserest($restline); $restsize = &setcharactersize($rest,$restlinehtml,''); $family = $optionvalues{'family'}; $childfamily = $optionvalues{'childfamily'}; $world = $optionvalues{'world'}; $body = $optionvalues{'body'}; $style = $optionvalues{'style'}; $multimedia = $optionvalues{'multimedia'}; $addon = $optionvalues{'addon'}; $slaveversion = $optionvalues{'slaveversion'}; $urlstem = $optionvalues{'urlstem'}; $search = $optionvalues{'search'}; $view = $optioncount{'view'}; $path = $optioncount{'path'}; $realfile =$optionvalues{'filename'}; # if( defined($list1=$optionvalues{'template'}) ) { open(TEMPLATEFILE,"<".$list1) || die("\nSorry couldn't open ",$list1,"\n"); @data=; $lasti=@data; } # # Process data for this file! # # Loop over file make commands open(REALFILE,">".$realfile) || die("\nSorry couldn't open ",$realfile,"\n"); # # Loop over template lines PRINTWWW: for($i=0;$i<$lasti;$i++) { $loopsize =1; for( $looping=0; $looping < $loopsize; $looping++) { $end=$data[$i]; chomp($end); $lineacc=''; while($end) { if( &curlyscan($end) ) { $lineacc .= $begin; $testwww = $classwww{$tag}; if( $testwww == 3 ) { $grab= eval('$'.$tagvalue); next PRINTWWW unless( defined( $grab ) ); next PRINTWWW if( $grab eq ''); if( $classwww{$tagvalue} == 1) { next PRINTWWW if( $grab == 0 ); } } if( $testwww == 1) { $loopsize = eval('$'.$tag ); $grab = eval('$optionarray[' . $looping . ']{"'. $tag .'"}'); $grab =~s/,/","/; $lineacc .= $grab; } if( $testwww == 4 ) { print REALFILE $lineacc,"\n" if($lineacc); $lineacc=''; for( $child=0; $child< $linkset; $child++) { print REALFILE 'top.bigboss.AccumulateIndex("child","' . $linkurls[$child] . '",'.$linkurlsdisabled[$child].');',"\n"; if( $linkurlsdisabled[$child] > 0 ) { print REALFILE 'top.bigboss.AccumulateIndex("childtitle","' . $linktitle[$child].'");',"\n"; } } } $lineacc .= eval( '$'.$tag ) if( $testwww == 2 ); } # End successive calls to curlyscan in each line else { $lineacc .= $begin; last; } # } # End scan of line with while($end) # print REALFILE $lineacc,"\n" ; } # End loop over $looping # } # End loop reading lines of template # close(REALFILE); # undef $optionvalues{'filename'}; undef $optionvalues{'template'}; undef $optionvalues_html{'filename'}; undef $optionvalues{'view'}; undef $optionvalues_html{'view'}; undef $optionvalues{'path'}; undef $optionvalues_html{'path'}; undef $optionvalues{'rest'}; undef $optionvalues_html{'rest'}; undef $optionvalues{'restfile'}; undef $optionvalues_html{'restfile'}; undef $optionvalues{'urlstem'}; undef $optionvalues_html{'urlstem'}; undef $optionvalues{'search'}; undef $optionvalues_html{'search'}; undef $optionvalues{'addon'}; undef $optionvalues_html{'addon'}; undef $optionvalues{'slaveversion'}; undef $optionvalues_html{'slaveversion'}; undef %optionarray; undef %optionarray_html; undef %optioncount; # return; } # # Analyse line for links used in an index sub analyserest { # my($filelines)=@_; my($newrest,$crlf,$nextline,$one,$two); # $newrest =''; while($filelines) { $crlf = index($filelines,"\n"); if( $crlf < 0 ) { $nextline = $filelines; $filelines=''; } else { $nextline = substr($filelines,0,$crlf); $filelines = substr($filelines,$crlf+1); } if( $nextline =~ m%^link:\s*\{([^\}]*)\}(.*)% ) { $one=$1; $two=$2; $linkurls[$linkset]=$one; $linkurlsdisabled[$linkset]=0; $linktitle[$linkset] = &protectquote($two); ++$linkset; $nextline = ' ' . $two . ''; } if( $nextline =~ m%^linkdisabled:\s*\{([^\}]*)\}(.*)% ) { $one=$1; $two=$2; $linkurls[$linkset]=$one; $linkurlsdisabled[$linkset]=1; $linktitle[$linkset] = &protectquote($two); ++$linkset; $nextline = ' ' . $two . ''; } elsif( $target ) { $nextline =~ s%href=%${target}href=%; } $newrest .= $nextline."\n"; } return $newrest; # } # End analyserest # # Protect quotes in String sub protectquote { # return backslashed string # my($dangerous)=@_; $dangerous =~ s/([^\\])'/$1\\'/g; $dangerous =~ s/([^\\])"/$1\\"/g; return $dangerous; # } # End protectquote # sub setcharactersize { # return additional character string info # my($charstring,$html,$currentsummary)=@_; my($count,$left,$begin,$num,$newpos); $count=0; # if($html == 1 ) { # This has HTML tags $charstring =~ s%<[^>]*>%%g; } # End removing tag data $begin=0; $left=length($charstring); while( ($newpos = index($charstring,"\n",$begin)) > -1 ) { # Newlines embedded $num=$newpos-$begin; if( $num > 0 ) { ++$count; if($count >10) { $count=1; $currentsummary .=")\ntop.bigboss.textsize(\'contd\'"; } $currentsummary .= ',' ; $currentsummary .= $num; } $left -= ($num+1); $begin=$newpos+1; } if($left>0) { # No newlines/remainder $currentsummary .= ',' ; $currentsummary .= $left; } return $currentsummary; # } # End setcharactersize # sub tohtml { # Convert HTML magic characters in current line my($convline)=@_; return($convline) unless $convline; $convline =~ s/&/&/g; $convline =~ s//>/g; $convline =~ s/"/"/g; $convline; } # # Process {tag=value} in templates # # Break up argument into $begin{$tag}$end finding first such pair sub curlyscan { # my($inline)=@_; my($line); # $line=$inline; $begin=''; while($line) { # if( $line =~ m%([^{]*){([^}]*)}(.*)% ) { if( $1 =~ m%\\$% ) { $begin .= $1 . '{'; $line = $2.'}'.$3; next; } $begin .= $1; $end=$3; $tag=$2; $tag =~ s/\s*//g; $tag =~ tr/A-Z/a-z/; if($tag =~ m%([^=]*)=(.*)%) { $tag=$1;$tagvalue=$2; } else { $tagvalue=0; } die("Illegal tag ",$tag," in ",$inline,"\n") unless $classwww{$tag}; return 1; } $begin=$inline; $end=''; $tag=''; return 0; } # End loop over starting { $begin=$inline; return 0; # } # End curly scan # # Join 2 lines together returning result # add white space as necessary sub join { my($a,$b) = @_; $a = $a . ' ' if( ($a =~ /\S$/) && ($b =~ /^\S/) ) ; return $a . $b ; } # 1;