File Coverage

blib/lib/HTML/WebMake/WmkFile.pm

Criterion	Covered	Total	%
statement	15	343	4.3
branch	0	116	0.0
condition	0	29	0.0
subroutine	5	33	15.1
pod	0	28	0.0
total	20	549	3.6

#

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'		=> [ ],
  };

  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->{parse_for_cgi}) {
    $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;

  # 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 ;)

  s/\001/<<001>>/gs;
  s/\002/<<002>>/gs;
  $self->{scopings} = { };
  for my $tag (qw(for metadefault attrdefault)) {
    if (!/<\/$tag>/) {
      $self->{scopings}->{$tag} = 0; next;
    }

    s/<$tag(\b[^>]*[^\/]>)/\001$1/gs;
    s/<\/$tag>/\002/gs;

    my $count = 0;
    while (s{\001([^>]+)>([^\001\002]+)\002}
    		{<$tag$count$1>$2<\/$tag$count>}gis)
    {
      $count++;
    }
    $self->{scopings}->{$tag} = $count;
  }
  s/<<001>>/\001/gs;
  s/<<002>>/\002/gs;

  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->{parse_for_cgi}) {
    $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.
    $util->strip_first_lone_tag (\$_, "include",
				  $self, \&tag_include, qw(file));
    $util->strip_first_lone_tag (\$_, "use",
				  $self, \&tag_use, qw(plugin));

    if (!$self->{parse_for_cgi}) {
      $self->{main}->eval_code_at_parse (\$_);
    } 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; }
    }

    # Declarations.
    $util->strip_first_tag_block (\$_, "content",
				  $self, \&tag_content, qw(name));
    $util->strip_first_lone_tag (\$_, "contents",
				  $self, \&tag_contents, qw(src name));
    $util->strip_first_tag_block (\$_, "template",
				  $self, \&tag_template, qw(name));
    $util->strip_first_lone_tag (\$_, "templates",
				  $self, \&tag_templates, qw(src name));
    $util->strip_first_tag_block (\$_, "contenttable",
				  $self, \&tag_contenttable, qw());
    $util->strip_first_lone_tag (\$_, "media",
				  $self, \&tag_media, qw(src name));

    if (/^
      $util->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 (/^
      $util->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));
      }
    }

    $util->strip_first_tag (\$_, "metatable",
				  $self, \&tag_metatable, qw());
    $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 (/^
      my $i;
      for ($i = 0; $i < $self->{scopings}->{"for"}; $i++) {
	$util->strip_first_tag_block (\$_, "for".$i,
				      $self, \&tag_for, qw(name values));
      }
    }

    # Outputs.
    $util->strip_first_tag_block (\$_, "out",
				  $self, \&tag_out, qw(file));

    # 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));

    # 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; $_ = $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;
}

# -------------------------------------------------------------------------

sub subst_attrs {
  my ($self, $tagname, $attrs) = @_;
  return if ($self->{parse_for_cgi});

  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);
  $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);
  $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 ("", $attrs);
  $self->{main}->set_option ($attrs->{name}, $attrs->{value});
  "";
}

# -------------------------------------------------------------------------

sub tag_editcgi {
  my ($self, $tag, $attrs, $text) = @_;

  $self->subst_attrs ("", $attrs);
  $self->{main}->add_url ("WebMake.EditCGI", $attrs->{href});
  "";
}

# -------------------------------------------------------------------------

sub tag_viewcgi {
  my ($self, $tag, $attrs, $text) = @_;

  $self->subst_attrs ("", $attrs);
  $self->{main}->add_url ("WebMake.ViewCGI", $attrs->{href});
  "";
}

# -------------------------------------------------------------------------

sub tag_site {
  my ($self, $tag, $attrs, $text) = @_;

  $self->subst_attrs ("", $attrs);
  $self->{main}->add_url ("WebMake.SiteHref", $attrs->{href});
  "";
}

# -------------------------------------------------------------------------

sub tag_content {
  my ($self, $tag, $attrs, $text) = @_;

  $self->cgi_add ($tag, $CGI_EDIT_AS_TEXT, $text, $attrs) and return '';
  $self->subst_attrs ("", $attrs);
  my $name = $attrs->{name};
  if (!defined $name) {
    carp ("Unnamed content found in ".$self->{filename}.": $text\n");
    return;
  }

  if (defined $attrs->{root}) {
    warn "warning: \${$name}: 'root' attribute is deprecated, ".
    		"use 'isroot' instead\n";
    $attrs->{isroot} = $attrs->{root};	# backwards compat
  }

  $self->{main}->add_content ($name, $self, $attrs, $text);
  "";
}

sub tag_contents {
  my ($self, $tag, $attrs, $text) = @_;

  $self->cgi_add_datasource ($tag, $attrs) and return '';
  $self->subst_attrs ("", $attrs);
  my $lister = new HTML::WebMake::Contents ($self->{main},
  			$attrs->{src}, $attrs->{name}, $attrs);
  $lister->add();
  "";
}

sub tag_template {
  my ($self, $tag, $attrs, $text) = @_;

  $self->cgi_add ($tag, $CGI_EDIT_AS_TEXT, $text, $attrs) and return '';
  $self->subst_attrs ("