File Coverage

blib/lib/HTML/WebMake/Util.pm

Criterion	Covered	Total	%
statement	21	105	20.0
branch	0	32	0.0
condition	0	12	0.0
subroutine	7	22	31.8
pod	1	13	7.6
total	29	184	15.7

#

package HTML::WebMake::Util;


use Carp;
use File::Basename;
use File::Path;
use File::Spec;
use Cwd;
use strict;

use vars	qw{
  	@ISA
};




###########################################################################

sub new ($) {
  my $class = shift;
  $class = ref($class) || $class;

  my $self = {
    'last_tag_text' => undef,
  };

  bless ($self, $class);
  $self;
}

sub dbg { HTML::WebMake::Main::dbg (@_); }

###########################################################################

sub glob_to_re ($$) {
  my ($self, $patt) = @_;

  if (!defined $patt) { return $patt; }
  if ($patt =~ s/^RE://) { return $patt; }

  $patt =~ s:([].+^\-\${}[|]):\\$1:g;
  $patt =~ s/\\\.\\\.\\\./.*/g;
  $patt =~ s/\*/[^\/]*/g;
  $patt =~ s/\?/./g;
  '^'.$patt.'$';
}

###########################################################################

sub parse_boolean ($$) {
  my ($self, $val) = @_;

  if (defined $val && $val =~ /^(?:true|yes|on|y|1)$/i) {
    1;
  } else {
    0;
  }
}

###########################################################################

sub parse_xml_tag_attributes ($$$$$) {
  my ($self, $tag, $origtxt, $filename, @reqd_attrs) = @_;
  my $attrtxt = " ".$origtxt." ";
  my $attrs = { };

  #dbg ("tag: <$tag$origtxt>");
  while ($attrtxt =~ s{\s([A-Z0-9a-z_]+)\s*=\s*\"([^\"]*?)\"\s}{ }is) {
    #dbg ("tag: <$tag$attrtxt>: $1=$2");
    my ($atname, $atval) = ($1, $2); $atname =~ tr/A-Z/a-z/;
    $attrs->{$atname} = $atval;
  }                             # fix vim highlighting: "
  while ($attrtxt =~ s{\s([A-Z0-9a-z_]+)\s*=\s*\'([^\']*?)\'\s}{ }is) {
    my ($atname, $atval) = ($1, $2); $atname =~ tr/A-Z/a-z/;
    $attrs->{$atname} = $atval;
  }                             # fix vim highlighting: '
  while ($attrtxt =~ s{\s([A-Z0-9a-z_]+)\s*=\s*(\S*)\s}{ }is) {
    my ($atname, $atval) = ($1, $2); $atname =~ tr/A-Z/a-z/;
    $attrs->{$atname} = $atval;
  }

  foreach my $attr (@reqd_attrs) {
    if (!defined $attrs->{$attr}) {
      warn ($filename.": tag \"".$tag.
        "\" is missing required attribute \"$attr\": <$tag $origtxt>\n");
      return;
    }
  }

  return $attrs;
}

###########################################################################

sub set_filename ($$) {
  my ($self, $filename) = @_;
  $self->{filename} = $filename;
}

sub strip_tags ($$$$$@) {
  my ($self, $file, $tag, $taghandler, $tagfn, @reqd_attrs) = @_;

  return unless $file =~ m{<${tag}\b}is;

  $file =~ s{<${tag}([^>]*?)/>}{
    $self->_found_tag ($tag, $1, '', 1, \@reqd_attrs, $taghandler, $tagfn);
  }gies;

  $file =~ s{<${tag}([^>]*?)>(.*?)<\/\s*${tag}\s*>}{
    $self->_found_tag ($tag, $1, $2, 0, \@reqd_attrs, $taghandler, $tagfn);
  }gies;

  $file;
}

sub _strip_first_tag ($$$$$$@) {
  my ($self, $paired, $textref, $tag, $taghandler, $tagfn, @reqd_attrs) = @_;

  $self->{last_tag_text} = $self->{last_tag_regexp} = undef;
  return unless $$textref =~ m{^\s*<${tag}\b}is;

  if ($paired == 0 || $paired == 2) {
    $$textref =~ s{^\s*<\S+([^>]*?)/>}{
      $self->_found_tag ($tag, $1, '', 1, \@reqd_attrs, $taghandler, $tagfn);
    }gies and return;
  }

  if ($paired == 1 || $paired == 2) {
    $$textref =~ s{^\s*<\S+([^>]*?)>(.*?)<\/\s*${tag}\s*>}{
      $self->_found_tag ($tag, $1, $2, 0, \@reqd_attrs, $taghandler, $tagfn);
    }gies and return;
  }
}

sub strip_first_tag ($$$$$@) {
  return shift->_strip_first_tag (2, @_);
}
sub strip_first_lone_tag ($$$$$@) {
  return shift->_strip_first_tag (0, @_);
}
sub strip_first_tag_block ($$$$$@) {
  return shift->_strip_first_tag (1, @_);
}

sub _found_tag ($$$$$$$) {
  my ($self, $tag, $origtxt, $text, $isempty,
  	$reqd_attrs, $taghandler, $tagfn) = @_;

  $self->{last_tag_text} = '<'.$tag.$origtxt.'> ... ';

  if ($self->{generate_tag_regexps}) {
    if ($isempty) {
      $self->{last_tag_regexp} = qr/ \Q<${tag}${origtxt}\/>\E /isx;

    } else {
      $self->{last_tag_regexp} = qr/ \Q<${tag}${origtxt}>\E
				    .*? <\/\s*\Q${tag}\E\s*> /isx;
    }
  }

  my $attrs = $self->parse_xml_tag_attributes ($tag, $origtxt,
  			$self->{filename}, @{$reqd_attrs});
  if (!defined $attrs) { return; }

  &{$tagfn} ($taghandler, $tag, $attrs, $text);
}

###########################################################################

=item @sorted = sort_by_score_title (@list);

A sort function (see C) which sorts a list of content items in
order of their C metadata, with alphanumeric sorting by C used </td>
</tr>

<tr>
<td  class="h" >
<a name="177">177</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> for items of the same score. </td>
</tr>

<tr>
<td  class="h" >
<a name="178">178</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="179">179</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> =cut </td>
</tr>

<tr>
<td  class="h" >
<a name="180">180</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="181">181</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> sub sort_by_score_title { </td>
</tr>

<tr>
<td  class="h" >
<a name="182">182</a>
</td>

<td  class="c0" >

0

</td>

<td >

 

</td>

<td >

 

</td>

<td  class="c0" >
 <a href="blib-lib-HTML-WebMake-Util-pm--subroutine.html#182-1"> 
0
 </a> 
</td>

<td  class="c3" >
 <a href="blib-lib-HTML-WebMake-Util-pm--subroutine.html#182-1"> 
1
 </a> 
</td>

<td >

 

</td>

<td class="s">   my $cmp = $a->get_score() <=> $b->get_score(); </td>
</tr>

<tr>
<td  class="h" >
<a name="183">183</a>
</td>

<td  class="c0" >

0

</td>

<td  class="c0" >
 <a href="blib-lib-HTML-WebMake-Util-pm--branch.html#183-1"> 
  0
 </a> 
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   if ($cmp != 0) { return $cmp; } </td>
</tr>

<tr>
<td  class="h" >
<a > </a>
</td>

<td  class="c0" >

0

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="184">184</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="185">185</a>
</td>

<td  class="c0" >

0

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   $a->get_title() cmp $b->get_title(); </td>
</tr>

<tr>
<td  class="h" >
<a name="186">186</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> } </td>
</tr>

<tr>
<td  class="h" >
<a name="187">187</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="188">188</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> # a convenience function to do the sort for us, otherwise some package </td>
</tr>

<tr>
<td  class="h" >
<a name="189">189</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> # twiddling is required (as $a and $b are set in the caller's pkg). </td>
</tr>

<tr>
<td  class="h" >
<a name="190">190</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> # </td>
</tr>

<tr>
<td  class="h" >
<a name="191">191</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> sub sort_list_by_score_title { </td>
</tr>

<tr>
<td  class="h" >
<a name="192">192</a>
</td>

<td  class="c0" >

0

</td>

<td >

 

</td>

<td >

 

</td>

<td  class="c0" >
 <a href="blib-lib-HTML-WebMake-Util-pm--subroutine.html#192-1"> 
0
 </a> 
</td>

<td  class="c0" >
 <a href="blib-lib-HTML-WebMake-Util-pm--subroutine.html#192-1"> 
0
 </a> 
</td>

<td >

 

</td>

<td class="s">   my ($self, @list) = @_; </td>
</tr>

<tr>
<td  class="h" >
<a name="193">193</a>
</td>

<td  class="c0" >

0

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   return sort sort_by_score_title @list; </td>
</tr>

<tr>
<td  class="h" >
<a name="194">194</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> } </td>
</tr>

<tr>
<td  class="h" >
<a name="195">195</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="196">196</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> ########################################################################### </td>
</tr>

<tr>
<td  class="h" >
<a name="197">197</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="198">198</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> sub text_eol { </td>
</tr>

<tr>
<td  class="h" >
<a name="199">199</a>
</td>

<td  class="c0" >

0

</td>

<td >

 

</td>

<td >

 

</td>

<td  class="c0" >
 <a href="blib-lib-HTML-WebMake-Util-pm--subroutine.html#199-1"> 
0
 </a> 
</td>

<td  class="c0" >
 <a href="blib-lib-HTML-WebMake-Util-pm--subroutine.html#199-1"> 
0
 </a> 
</td>

<td >

 

</td>

<td class="s">   my ($self) = @_; </td>
</tr>

<tr>
<td  class="h" >
<a name="200">200</a>
</td>

<td  class="c0" >

0

</td>

<td  class="c0" >
 <a href="blib-lib-HTML-WebMake-Util-pm--branch.html#200-1"> 
  0
 </a> 
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   if ($^O =~ /(?:win|os2)/i) { </td>
</tr>

<tr>
<td  class="h" >
<a > </a>
</td>

<td >

 

</td>

<td  class="c0" >
 <a href="blib-lib-HTML-WebMake-Util-pm--branch.html#-2"> 
  0
 </a> 
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="201">201</a>
</td>

<td  class="c0" >

0

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">     return "\r\n"; </td>
</tr>

<tr>
<td  class="h" >
<a name="202">202</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   } elsif ($^O =~ /(?:mac)/i) { </td>
</tr>

<tr>
<td  class="h" >
<a name="203">203</a>
</td>

<td  class="c0" >

0

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">     return "\r"; </td>
</tr>

<tr>
<td  class="h" >
<a name="204">204</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   } else { </td>
</tr>

<tr>
<td  class="h" >
<a name="205">205</a>
</td>

<td  class="c0" >

0

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">     return "\n"; </td>
</tr>

<tr>
<td  class="h" >
<a name="206">206</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   } </td>
</tr>

<tr>
<td  class="h" >
<a name="207">207</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> } </td>
</tr>

<tr>
<td  class="h" >
<a name="208">208</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="209">209</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> ########################################################################### </td>
</tr>

<tr>
<td  class="h" >
<a name="210">210</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

<tr>
<td  class="h" >
<a name="211">211</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s"> 1; </td>
</tr>

<tr>
<td  class="h" >
<a name="212">212</a>
</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td >

 

</td>

<td class="s">   </td>
</tr>

</table>

</body>
</html>