#!/bin/perl # Grammar into HTML # Read in sparql.txt and the tokens.txt file # BUGS: The token "||" gets corrupted as it looks like a ruke | $/ = undef ; # Just table or full page. $TABLE = 1 ; $grammarFile = 'sparql.txt' ; $tokensFile = 'tokens.txt' ; ## $grammarFile = 's.txt' ; ## $tokensFile = 't.txt' ; $grammar = &readFile($grammarFile) ; $tokens = &readFile($tokensFile) ; $grammar =~ s!DOCUMENT START!! ; $grammar =~ s!NON-TERMINALS!! ; $grammar =~ s!DOCUMENT END!! ; $grammar =~ s!//.*!!g ; $grammar =~ s!\r!!g ; # remove leading whitespace $grammar =~ s!^[\n\s]*!\n! ; # Merge alts $grammar =~ s!\n\s*\|!\ |!g ; $tokens =~ s!//.*!!g ; $tokens =~ s!\r!!g ; ## Grammar #print "GRAMMAR\n" ; @g = split(/\n\s*/, $grammar) ; @rules = () ; %ruleMap = () ; %tokenMap = () ; %inline = () ; # Grammar rules # Direct from "jjdoc -TEXT=true" for $g (@g) { ($rulename, $rulebody) = split(/:=/,$g) ; $rulename =~ s!^\s*!! ; $rulename =~ s!\s*$!! ; $rulebody =~ s!^\s*!! ; $rulebody =~ s!\s*$!! ; # Remove outer brackets # $rulebody =~ s!^\((.*)\)$!$1! ; # Remove <> round tokens #$rulebody =~ s/\<(\w+)\>/$1/g ; # Leave in - so tokens distinguished from rules next if $rulename eq '' ; #next if $rulebody eq '' ; # Skip the root rule. next if ( $rulename eq 'CompilationUnit' ) ; $rulebody = 'Perl 5 regular expression' if ( $rulename eq 'PatternLiteral' ) ; push @rules, $rulename ; warn "Duplicate rule (grammar): $rulename\n" if defined($ruleMap{$rulename}) ; $ruleMap{$rulename} = $rulebody ; ## print "----------\n" ; ## print $rulename,"\n" ; ## print $rulebody,"\n" ; } # Tokens # Produced by "jj2tokens" # Hand edited to indicate the inlines $tokens =~ s/\n+/\n/g ; $tokens =~ s/^\n// ; @t = split(/\n(?=\<|\[)/, $tokens) ; for $t (@t) { ($tokenname,$tokenbody) = split(/::=/, $t) ; $tokenname =~ s!^\s*!! ; $tokenname =~ s!\s*$!! ; #$tokenname =~ s/^\$//g ; $tokenname =~ s/#// ; $tokenbody =~ s!^\s*!! ; $tokenbody =~ s!\s*$!! ; # Remove <> round tokens #$tokenbody =~ s/\<(\w+)\>/$1/g ; # Leave in - so tokens distinguished from rules # Remove outer () # $tokenbody =~ s!^\((.*)\)$!$1! ; # Inline? if ( $tokenname =~ /^\[\<\w*\>\]/ ) { warn "Duplicate inline (token): $tokenname\n" if defined($inline{$tokenname}) ; $tokenname =~ s/^\[//g ; $tokenname =~ s/\]$//g ; $tokenbody =~ s/"/'/g ; # '" $inline{$tokenname} = $tokenbody ; #print "INLINE: ",$tokenname," => ",$tokenbody,"\n" ; } else { push @rules, $tokenname ; warn "Duplicate rule (token): $tokenname\n" if defined($tokenMap{$tokenname}) ; $ruleMap{$tokenname} = $tokenbody ; } } # Table if ( ! $TABLE ) { print "\n"; print "\n"; print "\n" ; print "\n"; print "\n"; print "\n" ; } print "

\n" ; print " \n" ; $ruleNum = 0 ; for $r (@rules) { $ruleNum++ ; $rulename = $r ; $rulebody = $ruleMap{$rulename} ; $rb = $rulebody ; ## Do before '||' substitution ##$rb =~ s%(?\|%g ; # Simpler $rb =~ s%\|%\
\|%g ; # Inlines for $k (keys %inline) { $s = span('token', $inline{$k}) ; ## $rb =~ s/(\W|^)$k(\W)/$1$s$2/g ; ## $rb =~ s/(\W|^)$k$/$1$s/g ; $rb =~ s/$k/$s/g ; } # Add hrefs - issue if one is a substring of another \W helps. for $k (keys %ruleMap) { $s = href("r-".$k,$k) ; #print "S:",$s,"\n" ; $k = quotemeta $k ; $rb =~ s/(\W)$k(\W)/$1$s$2/g ; $rb =~ s/^$k(\W)/$s$1/g ; $rb =~ s/(\W)$k$/$1$s/g ; $rb =~ s/^$k$/$s/g ; } #exit if $ruleNum > 2 ; # Tidy up. mess of '' $rn = anchor("r-".$rulename, $rulename) ; print "\n" ; print "\n" ; $rlabel = '[' . $ruleNum . '] ' ; print " \n" ; #print " \n" ; print " \n" ; print " \n" ; #print " \n" ; print " \n" ; print "\n" ; # $rule{$rulename, $rulebody) ; # print $rulename , "\n" ; } print "

",code('gRuleLabel', $rlabel),"

",span('gRuleHead', $rn),"

",code('gRuleHead',$rn),"

::=

",span('gRuleBody',$rb),"

",code('gRuleBody',$rb),"

\n" ; print "

\n" ; if ( !$TABLE ) { print "\n" ; print "\n" ; print "\n" ; } sub readFile { my $f = $_[0] ; open(F, "$f") || die "$!"; my $s = ; return $s ; } sub esc { my $s = $_[0] ; $s =~ s/&/&/g ; $s =~ s//>/g ; return $s ; } sub span { my $c = $_[0] ; my $t = $_[1] ; # Not escaped - for nesting my $s = '' . $t . '' ; return $s ; } sub href { my $a = $_[0] ; my $t = $_[1] ; $a = sane($a) ; $t = esc($t) ; my $s = '' . $t . '' ; return $s ; } sub anchor { my $a = $_[0] ; my $t = $_[1] ; $a = sane($a) ; $t = esc($t) ; my $s = '' . $t . '' ; return $s ; } sub sane { my $a = $_[0] ; $a =~ s/\W//g ; return $a ; } sub code { my $c = $_[0] ; my $t = $_[1] ; return '' . $t . '' ; }