#
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 ($_ !~ /^);
1 while s/<\{!--.*?--\}>//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 ($_ !~ /^) {
# easy to spot; the Perl code returned '1' or something.
# flag it clearly.
s/\n.*$//gs;
$self->{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 ("