# package HTML::WebMake::WmkFile; use HTML::WebMake::File; use HTML::WebMake::MetaTable; use Carp; use strict; use vars qw{ @ISA $CGI_EDIT_AS_WMKFILE $CGI_EDIT_AS_DIR $CGI_EDIT_AS_TEXT $CGI_NON_EDITABLE }; @ISA = qw(HTML::WebMake::File); $CGI_EDIT_AS_WMKFILE = 1; $CGI_EDIT_AS_DIR = 2; $CGI_EDIT_AS_TEXT = 3; $CGI_NON_EDITABLE = 4; ########################################################################### sub new ($$$) { my $class = shift; $class = ref($class) || $class; my ($main, $filename) = @_; my $self = $class->SUPER::new ($main, $filename); $self->{cgi} = { 'fulltext' => undef, 'items' => [ ], keep_cgi_fulltext => 0, skip_eval_code => 0, skip_subst_attrs => 0, mk_cgi_items_array => 0, }; bless ($self, $class); $self; } # ------------------------------------------------------------------------- sub dbg { HTML::WebMake::Main::dbg (@_); } sub dbg2 { HTML::WebMake::Main::dbg2 (@_); } # ------------------------------------------------------------------------- sub parse { my ($self, $str) = @_; local ($_) = $str; if (!defined $self->{main}) { carp "no main defined in WmkFile::parse"; } if ($self->{keep_cgi_fulltext}) { $self->{cgi}->{fulltext} = $_; } # We don't use a proper XML parser, because: # (a) content blocks etc. can contain HTML tags which will not be # scoped correctly; # (b) we use <{perl }> blocks which are invalid XML; # (c) we allow attributes without "quotes". # So kludge it where required. We're probably faster this way # anyway ;) # trim off text before/after chunk s/^.*?]*?>//gis; s/<\/\s*webmake\s*>.*$//gis; $self->{scopings} = { }; for my $tag (qw(for metadefault attrdefault usemetaset)) { $self->{scopings}->{$tag} = 0; } $self->fix_scoped_tags (\$_); my $util = $self->{main}->{util}; if (!defined $util) { carp "no util defined in WmkFile::parse"; } $util->set_filename ($self->{filename}); # if we are parsing for the CGI scripts, make sure that the XML # parser also notes regular expressions which match each item, so that the # CGI code can rewrite the file easily later. if ($self->{mk_cgi_items_array}) { $util->{generate_tag_regexps} = 1; } my $prevpass; my ($lasttag, $lasteval); for (my $evalpass = 0; 1; $evalpass++) { last if (defined $prevpass && $_ eq $prevpass); $prevpass = $_; s/^\s+//gs; last if ($_ !~ /^//gs; # WebMake comments. 1 while s/^//gs; # XML-style comments. # Preprocessing. if (!$self->{skip_eval_code}) { $self->{main}->eval_code_at_parse (\$_); # This may have been set by a plugin that needs introspection # into the .wmk file; check it here. if ($self->{main}->{start_parsing_introspection}) { $self->set_parse_introspection(); $util->{generate_tag_regexps} = 1; $self->{main}->{start_parsing_introspection} = 0; } } else { 1 while s/^<{.*?}>//gs; # trim code, CGI mode doesn't need it } $self->{main}->getusertags()->subst_wmk_tags ($self->{filename}, \$_); { # if we got some eval code, store the text for error messages my $text = $self->{main}->{last_perl_code_text}; if (defined $text) { $lasteval = $text; $lasttag = undef; } } # Tags, ordered from most-likely to least-likely... $util->strip_first_tag_block (\$_, "out", $self, \&tag_out, qw(file)); $util->strip_first_tag_block (\$_, "content", $self, \&tag_content, qw(name)); $util->strip_first_tag_block (\$_, "template", $self, \&tag_template, qw(name)); $util->strip_first_lone_tag (\$_, "include", $self, \&tag_include, qw(file)); $util->strip_first_lone_tag (\$_, "use", $self, \&tag_use, qw(plugin)); $util->strip_first_lone_tag (\$_, "contents", $self, \&tag_contents, qw(src name)); $util->strip_first_lone_tag (\$_, "templates", $self, \&tag_templates, qw(src name)); $util->strip_first_lone_tag (\$_, "media", $self, \&tag_media, qw(src name)); $util->strip_first_tag_block (\$_, "contenttable", $self, \&tag_contenttable, qw()); if (/^strip_first_lone_tag (\$_, "metadefault", $self, \&tag_metadefault, qw(name)); my $i; for ($i = 0; $i < $self->{scopings}->{"metadefault"}; $i++) { $util->strip_first_tag_block (\$_, "metadefault".$i, $self, \&tag_metadefault, qw(name)); } } if (/^strip_first_lone_tag (\$_, "attrdefault", $self, \&tag_attrdefault, qw(name)); my $i; for ($i = 0; $i < $self->{scopings}->{"attrdefault"}; $i++) { $util->strip_first_tag_block (\$_, "attrdefault".$i, $self, \&tag_attrdefault, qw(name)); } } if (/^{scopings}->{"usemetaset"}; $i++) { $util->strip_first_tag_block (\$_, "usemetaset".$i, $self, \&tag_usemetaset, qw(id)); } } $util->strip_first_tag (\$_, "metatable", $self, \&tag_metatable, qw()); $util->strip_first_tag (\$_, "metaset", $self, \&tag_metaset, qw(id)); $util->strip_first_tag (\$_, "sitemap", $self, \&tag_sitemap, qw(name node leaf)); $util->strip_first_tag (\$_, "navlinks", $self, \&tag_navlinks, qw(name map up prev next)); $util->strip_first_lone_tag (\$_, "breadcrumbs", $self, \&tag_breadcrumbs, qw(name map level)); # Loops if (/^{scopings}->{"for"}; $i++) { $util->strip_first_tag_block (\$_, "for".$i, $self, \&tag_for, qw(name values)); } } # Misc. $util->strip_first_lone_tag (\$_, "cache", $self, \&tag_cache, qw(dir)); $util->strip_first_lone_tag (\$_, "option", $self, \&tag_option, qw(name value)); # CGIs and hrefs $util->strip_first_lone_tag (\$_, "editcgi", $self, \&tag_editcgi, qw(href)); $util->strip_first_lone_tag (\$_, "viewcgi", $self, \&tag_viewcgi, qw(href)); $util->strip_first_lone_tag (\$_, "site", $self, \&tag_site, qw(href)); $util->strip_first_tag_block (\$_, "action", $self, \&tag_action, qw(event)); # if we got some tags, store the text for error messages my $text = $util->{last_tag_text}; if (defined $text) { $lasttag = $text; $lasteval = undef; } } # if there's any text left in the file that we couldn't parse, # it's an error, so warn about it. # if (/\S/) { my $failuretext = $lasttag; if (defined $lasteval) { if ($_ !~ /^{main}->fail ("Perl code didn't return valid WebMake code:\n". "\t$lasteval\n\t=> \"$_\"\n"); return 0; } $failuretext = $lasteval; } /^([^<].*?>.{40,40})/s; if (defined $1) { $_ = $1; } s/\s+/ /gs; $lasttag ||= ''; $self->{main}->fail ("WMK file contains unparseable data at or after:\n". "\t$lasttag\n\t$_ ...\"\n"); return 0; } return 1; } # ------------------------------------------------------------------------- # handle scoped tags. Since we don't use a proper XML parser, we have to # rewrite them here. We convert them to single-character markers (\001 or # \002) indicating a start tag or end tag, then loop until all appearances of # the tag have been converted. We then convert them back to text, with a # scope number attached. Until Perl can do a regexp like this: # # /]*>[^/ # # we're probably stuck doing it this way. Hey, don't knock it, it works ;) sub fix_scoped_tags { my ($self, $txt) = @_; $$txt =~ s/\001/<<001>>/gs; $$txt =~ s/\002/<<002>>/gs; for my $tag (qw(for metadefault attrdefault usemetaset)) { next if ($$txt !~ /<\/$tag>/); $$txt =~ s/<$tag(\b[^>]*[^\/]>)/\001$1/gs; $$txt =~ s/<\/$tag>/\002/gs; my $count = $self->{scopings}->{$tag}; while ($$txt =~ s{\001([^>]+)>([^\001\002]+)\002} {<$tag$count$1>$2<\/$tag$count>}gis) { $self->{scopings}->{$tag}++; $count++; } } $$txt =~ s/<<001>>/\001/gs; $$txt =~ s/<<002>>/\002/gs; } # ------------------------------------------------------------------------- sub subst_attrs { my ($self, $tagname, $attrs) = @_; return if ($self->{skip_subst_attrs}); if (defined ($attrs->{name})) { $tagname .= " \"".$attrs->{name}."\""; # for errors } my ($k, $v); while (($k, $v) = each %{$attrs}) { next unless (defined $k && defined $v); $attrs->{$k} = $self->{main}->fileless_subst ($tagname, $v); } } # ------------------------------------------------------------------------- sub tag_include { my ($self, $tag, $attrs, $text) = @_; $self->cgi_add ($tag, $CGI_EDIT_AS_WMKFILE, $attrs->{file}, $attrs) and return ''; $self->subst_attrs ("", $attrs); my $file = $attrs->{file}; if (!open (INC, "< $file")) { die "Cannot open include file: $file\n"; } my @s = stat INC; my $inc = join ('', ); close INC; dbg ("included file: \"$file\""); $self->{main}->set_file_modtime ($file, $s[9]); $self->add_dep ($file); $self->fix_scoped_tags (\$inc); $inc; } # ------------------------------------------------------------------------- sub tag_use { my ($self, $tag, $attrs, $text) = @_; $self->subst_attrs ("", $attrs); my $plugin = $attrs->{plugin}; my $file; my @s; $file = '~/.webmake/plugins/'.$plugin.'.wmk'; $file = $self->{main}->sed_fname ($file); @s = stat $file; if (!defined $s[9]) { $file = '%l/'.$plugin.'.wmk'; $file = $self->{main}->sed_fname ($file); @s = stat $file; } if (!defined $s[9]) { die "Cannot open 'use' plugin: $plugin\n"; } foundit: if (!open (INC, "<$file")) { die "Cannot open 'use' file: $file\n"; } my $inc = join ('', ); close INC; dbg ("used file: \"$file\""); $self->{main}->set_file_modtime ($file, $s[9]); $self->add_dep ($file); $self->fix_scoped_tags (\$inc); # make the tag's attributes available to the plugin my $attrstr = ''; foreach my $key (keys %{$attrs}) { next if ($key eq 'plugin'); my $val = $attrs->{$key}; $val =~ s!!\</template>!g; # just in case $attrstr .= "\n"; } $attrstr.$inc; } # ------------------------------------------------------------------------- sub tag_cache { my ($self, $tag, $attrs, $text) = @_; $self->subst_attrs ("", $attrs); my $dir = $attrs->{dir}; $self->{main}->setcachefile ($dir); ""; } # ------------------------------------------------------------------------- sub tag_option { my ($self, $tag, $attrs, $text) = @_; $self->subst_attrs ("