package HTML::Band; 

use strict;

# we croak so we need Carp
# you may uncomment the qw( fatalsToBrowser) part for a web-friendy death
use CGI::Carp; # qw( fatalsToBrowser);  

use vars qw( $level $count $open $close );

$HTML::Band::VERSION = '0.40';

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

  my %parms = @_;
  my $self = {
    template => undef, 
    token => {
      '' => {}, 
    }, 
    bandlist => [], 
    bandhash => {}, 
  }; 
  bless $self, $class;    
  return $self;
}

sub template {
  my $self=shift;
  my $class=ref($self) || croak "$self is not an object";
  my %parms;

  return $self->{template} unless @_;
  if (@_ ==1) {
    $parms{scalar}=shift;
  }
  else {
    croak "odd parms" if @_%2;
    %parms=@_;
  }  
  if (exists $parms{file}) {
    $self->{file}=$parms{file};
    no strict 'refs';
    my $unique=ref({});
    open ($unique, $parms{file}) or return ($self->error($!));
    $parms{scalar}=join '', <$unique>;
    close $unique;
  }
  $self->{template}=$parms{scalar};

  return 1;
}

sub bandlist {
  my $self=shift;
  my $class=ref($self) || croak "$self is not an object";

  # gets or sets the bandlist (which must be an arrayref)
  # dies cuz its internal-ish

  my $bandlist=shift or return $self->{bandlist};
  croak "bandlist must be an arrayref" unless ref($bandlist)=~/^ARRAY/;

  $self->{bandlist}=$bandlist;
  return 1;
}

sub parse {
  my $self=shift;
  my $class=ref($self) || croak "$self is not an object";

  # this method parses the template data into an array of hashes and populates the 
  # bandlist attribute with a reference to it, stepping on any previous value of bandlist

  # it does this by splitting the template on its band (open and close) tags and calling
  # walklist with the array, which recusrively calls itself to create the the 
  # nested data structure.

  # dont forget to check the return

  my ($raw, @raw);
  @raw=split /(<\!--\s*\/?band.*?-->)/s, $self->template;

  return $self->error($self->error) unless $self->nest_ok;
  
  local ($level, $count, $open, $close)=(0,0,0,0);

#  $self->bandlist([$self->_walklist([@raw])], "0") or return $self->error($self->error);
  my @bandlist = $self->_walklist([@raw]) or return $self->error($self->error);

  # now we have to walk @bandlist again to link any "include refs" we find in there
  # to their named bands that we parsed and stashed in the %bandhash

  $self->bandlist([@bandlist]) or return $self->error($self->error);

  $self->linkrefs;

  return 1;
}

sub linkrefs { 
  my $self=shift;
  my $class=ref($self) || croak "$self is not an object";

  my $bandlistref = shift || $self->{bandlist};

  for my $thisband (@{$bandlistref}) {
    if (exists $thisband->{type} and $thisband->{type} eq 'include' and exists $thisband->{ref}) {
      croak "unspecified band reference found in bandlist" 
        unless defined $thisband->{ref} and length $thisband->{ref};
        $thisband = $self->{bandhash}->{$thisband->{ref}} if exists $self->{bandhash}->{$thisband->{ref}};
        # $thisband->{gotcha}= 'gotcha';

    }
    if (exists $thisband->{html} and ref($thisband->{html})=~/^ARRAY/) {
      # search them doggies too
      $self->linkrefs($thisband->{html});
    }
  }
}

sub _walklist { # internal - don't call it - and if you do, don't call me if it doesnt work
  my $self=shift;
  my $class=ref($self) || croak "$self is not an object";

  # returns an array of hashrefs corresponding to each band tag's contents 
  # at it's "level" of the data structure.  each band's hash gets an html key 
  # and optionally additional keys-value pairs based on the open-band-tag's tribs

  # when a band (that was opened at $mylevel) closes, (if it had more band tags within it) 
  # it recurses and populates the html key with the arrayref of the sub-bands' hashes
  # instead of the scalar html.  make sense? no? then don't call it.

  # treats non-explicitly-band-tagged html as if it was band tagged with no tribs.
  # dies on errors cuz you're not supposed to call it (did i mention that?)

  # you're supposed to use the parse method which checks for nesting errors first, 
  # knows how to call it, and knows what to do with the return.

  # the return is an array suitable for assignmet (as a reference) to the ->{bandlist}

  croak "arrayref not specififed" unless ref ($_[0]) =~/^ARRAY/;
  my @raw=@{$_[0]};
  my $debug=$_[1] or 0;

  my (%sub, @newarray, @contents, $mylevel);

  $mylevel=$level;
  print "<br>walking level $mylevel <blockquote>\n" if $debug;

  while (@raw) {
    my $this=shift @raw;
    $count++;
    my $that;

    if ($debug){
      print ("<pre>element: $count - $that\n") if ($that=$this)=~s/[<>\n]//sg;
    }

    # opening a band?
    if ($this=~/^<\!--\s*band\s*(.*)\s*-->$/) { 
      # any band
      $open++;
      $level++;

      if (($mylevel+1)==$level) {
        # band opened at the root level 
        if ($debug){
          print "opening at root: open=$open\tclose=$close\tlevel=$level\tmylevel=$mylevel\n";
        }

         # process the band tribs and make a %sub hash for it
        my $tribs=$1;
        my @tribs= split /(?:\s*=\s*")|(?:"\s*)/, $tribs;
        croak "odd trib value pairs at element $count: '$this'" if @tribs%2;
  
        # make the temp hash for this band's tribs
        %sub=(@tribs);
        next;
      }
      else {
        if ($debug){
          print "opening at sublevel: open=$open\tclose=$close\tlevel=$level\tmylevel=$mylevel\n";
        }
      }
    }
    # closing a band?
    if ($this=~/^<\!--\s*\/band(.*)\s*-->$/) { 
      # any close-band:
      $close++;
      if ($debug){
        print "closing:  open=$open\tclose=$close\tlevel=$level\tmylevel=$mylevel\n";
      }
      # this dies cuz nest_ok shoulda caught it
      croak "nesting error: close-band tag # $close at \@raw element: $count ".
        "has no opening tag at this level"  if ($level-1) < $mylevel;

      # closing the band opened at mylevel
      if (($level-1) == $mylevel) { 

        if (exists $sub{type} && $sub{type} eq 'include') { # included data
          # we'll ignore the band's contents and process data from elsewhere

          if (exists $sub{file}) { # include a file
            croak "file to include not specified at element $count" unless $sub{file};
  
            my $included=new HTML::Band;
  
            if ($sub{file} !~ m{^[/\\]} ) { # relative path specified
              # no relative paths if template was a scalar 
              croak "file included in scalar needs an absolute path" unless $self->{file};
              # prepend current path 
              my $path;
              ($path=$self->{file}) =~ s{^(.+[\\/])[^\\/]+$}{$1};
              $sub{file}=$path.$sub{file};
            }
  
            $included->template(file=>$sub{file})  
              or croak "can't include file: '$sub{file}' - ". $included->error;
            $included->parse 
              or croak "error parsing included file: '$sub{file}' - ". $included->error;
  
              # replace our ->{html} with the included parsed bands
            $sub{html}=$included->bandlist;
              
              # merge in any included tokens too
              if (exists $included->{token} and ref($included->{token})=~/^HASH/) {
                for my $tokenkey (keys %{$included->{token}}) {
                  $self->bandtoken( $tokenkey, 
                    %{$self->{token}->{$tokenkey}}, 
                    %{$included->{token}->{$tokenkey}}, 
                  ) or croak "error merging tokens included from '$sub{file}' - ". $self->error;
                }
              }
            }
            elsif (exists $sub{ref}) { # include type="ref" - include a band by reference
              croak "band reference to include not specified at element $count" 
                unless defined $sub{ref} and length $sub{ref};
              # do nothing; the name of the band to reference will just 
              # get pushed onto the bandlist here - and and parsed later (when encountered)
            }
          }
          else { # we're *NOT* an include - we need to process our contents
            if (@contents>1) { 
              # we have nested bands so need to recurse and walk our own @contents array
            $sub{html}=[$self->_walklist([@contents])];
          }
          else {
            # we were a "leaf" with a single scalar of (bandless) content 
            $sub{html}=$contents[0];
          }
        }

        # here we handle non-stream data: band references & inline token definitions
        if (exists $sub{type} and grep $_ eq $sub{type}, qw (ref token)) {
          if ($sub{type} eq 'ref') { # defining a band to be included elsewhere  
            # "ref" type data doesn't get pushed onto the
            # bandlist - we stash it in a bandhash for later retrieval
            # and we place the ref'd name in the bandlist as a placeholder
            croak "unnamed reference band at element $count" 
              unless exists $sub{name} and length $sub{name};
            $self->{bandhash}->{$sub{name}}={%sub};
            # push @newarray, {%sub};
          }
          elsif ($sub{type} eq 'token') { # defining token values inline from the template
            # "token" type content doesn't get pushed onto the
            # bandlist either - it gets tacked into the token->{band} hashref

            # token data must be scalar (no nested bands)
            croak "token-type bands cannot contain nested bands (include a ref instead)" 
              if @contents>1;

            # if a "namespace" trib is given, the token goes in that band's namespace
            # otherwise it's a global (anon-band) token

            #my $bandname = exists $sub{ref} && defined $sub{ref} ? $sub{ref} : '';
            my $bandname = exists $sub{namespace} && defined $sub{namespace} ? $sub{namespace} : '';
  
            # and it must have a defined, non-empty token name, thank you very much.
            croak "unnamed token definition at element $count" 
              unless exists $sub{name} and defined $sub{name} and length $sub{name};

            $self->token->{$bandname}->{$sub{name}}=$contents[0]; # a 4-level hashref --zowie!
          }
        }
        else { # and here we handle all the regular nicely stream-sequenced data
          push @newarray, {%sub};
        }

        # and here we clean up after ourselves for the next @raw chunk
        undef %sub;
        undef @contents;

      }
      # just closing a band opened in a sublevel 
      else { # just push it into @contents
        push @contents, $this;
      }
      $level--;
      next;
    }
    # processing a root-level element? 
    if ($level==$mylevel){ 
      if ($debug){
        print "anon root element: open=$open\tclose=$close\tlevel=$level\tmylevel=$mylevel\n";
      }
      # a close tag here would be an error
      if ($this=~/^<\!--\s*\/band(.*)\s*-->$/) { 
        $close++;
        # this dies cuz nest_ok shoulda caught it
        croak "close-band tag # $close at \@raw element: $count has no opening tag";
        $level--;
      }

      # just put root level element in anon hashes in @newarray
      push @newarray, {html=>$this};
      next;
    }
    
    # if we get here were processing a sub-level element...
    # push into contents array for further processing after level is complete
    if ($debug){
      print "subelement: open=$self->{open}\tclose=$close\tlevel=$level\tmylevel=$mylevel\n";
    }
    push @contents, $this;
    next;
  }
  continue {
    if ($debug){
      print "</pre>\n";
    }
  }
  print "</blockquote><br>finished walking level $mylevel\n" if $debug;
  # this dies cuz nest_ok shoulda caught it
  croak "open-band tag detected at level $level with no closing tag" if $level>$mylevel;

  return @newarray;
}

sub rowset{
  my $self=shift;
  my $class=ref($self) || croak "$self is not an object";

  # sets numbered tokens (hashrefs correspoding to the values in the rows) to be merged
  # takes a scalar set-name, and a list of hashrefs 
  
  my $setname=shift or croak "set name not specified";

#  return @{$self->{set}{$setname}} unless @_;
  my @hashset=@_;
  my $element;
  for (@hashset) {
    $element ++;
    return $self->error("element $element must be a hashref") unless ref($_)=~/^HASH/;
  }
  $self->bandtoken($setname, 'ROWS' => scalar(@hashset));
  my $row;
  for my $hashref (@hashset) {
    $row++;
    $self->bandtoken("$setname:$row", %{$hashref}, 'ROW_NUM' => $row);

    # now loop through the tokens and recurse if any are themselves arrarefs (of hashrefs --sheesh)
    for my $token (keys %{$hashref}) {
      if (ref($hashref->{$token})=~/^ARRAY/) {
        $self->rowset("$setname:$row:$token", @{$hashref->{$token}})
          or return $self->error($self->error);
      }
    }
  }
  return 1;
}

sub token {
  my $self=shift;
  my $class=ref($self) || die "$self is not an object";

  # gets or sets the ->{token} element (a hashref) conaining keys corresponding to 
  # band names with values which are themselves hashrefs (of regular hash), each 
  # key of which represents a token name and substitution value for that band.

#  my %parms = %{$self->{token}};
#  return {%parms} unless @_;
  return $self->{token} unless @_;

  croak "token must be a hashref" unless ref($_[0])=~/^HASH/;
  $self->{token}=shift;
}

sub bandtoken {
  my $self=shift;
  my $class=ref($self) || croak "$self is not an object";

  # sets the ->{token}{$band} element (a hashref) conaining keys corresponding to 
  # names and substitution values for the specified $band.
  # (takes and returns hashes as lists)

  # odd args should always passed: the band name, followed by key-value pairs.
  # if even args are passed, they are assumed to be pairs for the null band (global token)
  # if no args are passed 0 is returned an error set (can be ignored)

#  my %parms = %{$self->{token}};
  return $self->error("no band specified") unless @_;

  my $band = @_%2 ? (shift) : '';
  return $self->error($self->error) unless $self->token_ok({$band, {@_}});
  $self->{token}->{$band}={@_};
}

sub source  {
  no strict 'refs';

  my $self=shift;
  my $class=ref($self) || croak "$self is not an object";

  # extracts the source html from the bandlist data structure (or passed arrayref)
  # this reconstructs the template html (optionally with formatting and display options).

  # if an odd number of parms are passed, the first is shifted and assumed to be 
  # the arrayref you want to extract a template from.  the remaining (even number of)
  # parameters are assigned (to a hash) as the following optional named parms & values:
  #
  #  with_band_tags   => 1,    # reinserts legal (but derived) band tags
  #  hide_implied_tags  => 1,    # dont return band tags with no tribs
  #  htmlify    => 1,    # replaces < with &lt; and wraps all in <pre> tags
  #  indent    => 1,    # <blockquotes> each band's contents (shows nesting)
  #  highlight    => 1,   # use <div> and style tags to highlight band tags
  #   pretty    => 1,   # all of the above (highlight overrides with_band_tags)
  #  show_scope    => 1,   # displays effective token scope in the band tag line
  #  show_token    => 1,   # displays effective etoken vals in the band tag line
  #   testresults    => 1,    # show test results in tagline
  #
  #            # note that specifying any options above other than 
  #            # with_band_tags, htmlify and hide_implied_tags
  #            # will probably generate invalid html suitable only  
  #            # forcertain display purposes (if that).
  #            # the rest r used by the merge method (defaulted to 1)
  #  token      => {    # used by the merge method - DNFW
  #    bandname =>{    # hashref of {bandnames => {merge-names and values}}
  #      tokenname=>"value", ...}, ...}  
  #   merge      => 1,   # used by merge method to perform substitutions
  #  rows      => 1,    # return expanded rowsets where defined
  #  conditional    => 1,    # skip processing of conditional tags with test=0

  # returns a list of html scalars (in case you want to join with newlines or whatnot)
  # it dies if it gets unsuitable parms - cuz its sortof internal

  my $html = @_%2 ? shift : $self->bandlist;
  croak "not an arrayref" unless ref ($html)=~/^ARRAY/;

  my %parms=@_;
  my @formatargs=qw(with_band_tags hide_implied_tags htmlify indent highlight pretty);
  my @otherargs=qw(token namestack show_scope show_token testresults merge conditional rows);
  my $argspec="(".join (")|(", (@formatargs, @otherargs)).")";
  my @bad;
  die "bad argument(s): ".join(", ", @bad) if @bad =grep !/^$argspec$/, keys %parms;

  for (@formatargs) {
    $parms{$_}=1 if $parms{pretty};
  }
  
  my (@html, %token, %set, @namestack, @setstack);

  # get or default the tokens
  if (exists $parms{token}) {
    $parms{token} = ref($parms{token})=~/^(HASH)|(ARRAY)/ ? $parms{token} : {}; 
    confess $self->error unless $self->token_ok($parms{token});
    %token = %{$parms{token}}; 
  }
  else {
    %token= $self->token ? %{$self->token} : {};
  }
  
  # the current or "effective" token hash has "scope" so we keep track of 
  # the band names we are nested inside using @namestack.
  if (exists $parms{namestack}) {
    die "namestack parm must be an arrayref" unless ref($parms{namestack})=~/ARRAY/;
    @namestack = @{$parms{namestack}}; 
  }

  for my $band (@{$html}) {

    # update current scope list
    push @namestack, $band->{name} if $band->{name};

    # process rows 

    # find our parent-row's name:num
    my $parent_setname = (reverse grep (/\:\d+$/, @namestack))[0];

    # use the parentrow's name or our (presumably top-level) set name to determine or eff_name
    my $eff_setname = $parent_setname ? "$parent_setname:$band->{set}" : $band->{set};

    # use the effname to lookup our ->{ROWS} (what a kludge)
    my $loop = exists $parms{rows} && $parms{rows} 
      ? $band->{type} && $band->{type} eq 'row'
          ? $token{$eff_setname}->{ROWS} 
          :1
      :1;

    next unless $loop;
    for my $row (1..$loop) {
      if (exists $band->{type} && $band->{type} eq 'row') {
        push @namestack, "$eff_setname:$row";
      }

      # define the effective-token (current scope) by merging token hash keys

      # the global or anonymous token (designated by an empty key) is always in
      # effect if it exists so '' gets gets prepended to @namestack
      # when it is evaluated to define the effective token values for a given band
      my %etoken = (
        map (%{$token{$_}}, ('', @namestack)), 

        parent_set => $parent_setname, 
        eff_set => $eff_setname, 
      );

      # conditional processing
      my $result=$self->bandtest($band, {%etoken});
      next if $parms{conditional} and !$result;

      my $tribs = join " ", map "$_=\"$band->{$_}\"", grep !/^html$/, keys %{$band};
      my $implied = 1 unless grep !/^html$/, keys %{$band};
      $tribs .= " testresult=\"$result\"" 
        if $parms{testresults} and defined $result;
      $tribs .= " scope=\"('" . join ("', '", @namestack) ."')\"" 
        if $parms{show_scope};
      $tribs .= " tokens=(" . join (", ", map("$_ = '$etoken{$_}'", keys %etoken)) .")" 
        if $parms{show_tokens};

      unless ($parms{hide_implied_tags} && $implied) {
        # open-tag formatting 
        push @html, "<blockquote>" if $parms{indent};
  
        push @html, "<div style=\"background-color: #ffffff;\">band $tribs</div>" 
          if $parms{highlight};
        push @html, (($parms{htmlify}?"&lt;":"<"), "!--band $tribs-->") 
          if $parms{with_band_tags} && !$parms{highlight};
      }

      if (ref ($band->{html}) =~ /^ARRAY/) { # band contains other bands
        # recurse nested band
        push @html, $self->source( 
          $band->{html}, 
          %parms, 
          token => {%token},
          namestack => [@namestack],
        );
      }
      else { 
        # band's html element isnt an arrayref so it better be scalar
        # if not, this is majorly bad, so die 
        die "non-arrayref element isnt scalar" if ref ($band->{html});
  
        $band->{html}=~s/</&lt;/gs if $parms{htmlify};

        # do the data-merge (token substitutions)
        my $merged=$band->{html};
        if ($parms{merge}) {
          # sort the keys so $tokenname_long is tested before $tokenname
          for (reverse sort {length($a)<=>length($b)} keys %etoken) {
            $merged=~s/\$$_/$etoken{$_}/gs;
          }
          push @html, $merged;
        }
        else {
          push @html, $band->{html};
        }
      }
      if (exists $band->{type} && $band->{type} eq 'row') {
        pop @namestack;
      }
      unless ($parms{hide_implied_tags} && $implied) {
        # close-tag formatting 
        push @html, (($parms{htmlify}?"&lt;":"<"), "!--/band-->") 
            if $parms{with_band_tags} && !$parms{highlight};
        push @html, "</blockquote>" if $parms{indent};
      }
    }
  }
  continue {  
    pop @namestack if $band->{name};
  }

#  @html = ("<pre>", @html, "<pre>") if $parms{htmlify};
  return @html; 
}

sub merge {
  my $self=shift;
  my $class=ref($self) || croak "$self is not an object";

  croak "odd parms" if @_%2;
  return $self->source(merge=>1, rows=>1, conditional=>1, @_);
}

sub bandtest {
  my $self=shift;
  my $class=ref($self) || croak "$self is not an object";

  # takes a band reference and a token reference, expands the token vals
  # in the bands test and value keys, performs the test specified in the op key
  # and returns the test result: 1 or 0 (or undef if no test key exists)

  confess "band reference not a hashref" unless ref($_[0])=~/^HASH/;
  my %band=%{shift()};

  return "notest" unless exists $band{test};

  croak "token reference not a hashref" unless ref($_[0])=~/^HASH/;
  my %etoken=%{shift()};
  
  # expand test and value strings with effective tokens
  for my $term (qw(test value)) {
    if (exists $band{$term}) {
      for my $token (keys %etoken) {
        $band{$term}=~s/\$$token/$etoken{$token}/;
      }
    }
  }

  my ($test, $value, $op)  = ($band{test}, $band{value}, $band{op}) ;
  return $test unless (defined ($op) or defined($value));

  my @validops=('eq', 'ne', 'lt', 'gt', 'le', 'ge');
  $op = "eq" unless $op;
  return "undefined test op '$op' specified" unless grep /^$op$/, @validops;

  my $t_numeric = 1 if $test  =~ /^\s*\d+(\.\d+)?\s*$/;
  my $v_numeric = 1 if $value =~ /^\s*\d+(\.\d+)?\s*$/ ;

  my $t_char = 1 if $test  =~ /[^\s\d\.]/;
  my $v_char = 1 if $value =~ /[^\s\d\.]/;

  my $numeric = 1 if ($t_numeric or $v_numeric) and !($v_char or $t_char);

  for ($op) {
    /eq/ and return $numeric ? ($test == $value ? 1 : 0) : ($test eq $value ? 1 : 0);
    /ne/ and return $numeric ? ($test != $value ? 1 : 0) : ($test ne $value ? 1 : 0);

    /lt/ and return $numeric ? ($test < $value ? 1 : 0) : ($test lt $value ? 1 : 0);
    /gt/ and return $numeric ? ($test > $value ? 1 : 0) : ($test gt $value ? 1 : 0);

    /le/ and return $numeric ? ($test <= $value ? 1 : 0) : ($test le $value ? 1 : 0);
    /ge/ and return $numeric ? ($test >= $value ? 1 : 0) : ($test ge $value ? 1 : 0);
  }
}

sub nest_ok {
  my $self=shift;
  my $class=ref($self) || croak "$self is not an object";

  # this tests the object's template (or its single scalar argument) 
  # to see if its band tags are balanced and nested legally.
  # if they are, it returns 1
  # if not, it sets $self->error with its opinion and returns 0

  my $template = (shift || $self->{template});

  my @test=split /(<\!--\s*\/?band.*?-->)/s, $template;
  my ($this, $count, $open, $close, $nestlevel) = (0,0,0,0,0);
  
  while (@test) {
    $this=shift @test;
    $count++;
    if ($this =~/^band/) {
      $open++;
      $nestlevel++;
    }
    elsif ($this =~/^\/band/) {
      $close++;
      $nestlevel--;
    }
    return $self->error("Level became negative at element: $count.") if $nestlevel<0;
  }
  return $self->error("Final level not zero.") if $nestlevel>0;
  return $self->error("Unmatched band-" . ($open>$close? "open":"close") ." tag.")
    if $open != $close;
  # if we get here nesting looks ok
  return 1;
}

sub token_ok {
  my $self=shift;
  my $class=ref($self) || croak "$self is not an object";

  # this tests the object's token (or its single scalar argument) 
  # to see if it is legal, i.e. a reference to a hash of hashes, and that the 
  # values of the inner hash are not references. if its legal, it returns 1.
  # if not, it sets $self->error with its opinion and returns 0

#  my $token = (shift || $self->{token});
  my $token = shift;

  return $self->error("token not a hashref") unless ref($token)=~/^HASH/;
  my %token=%{$token};

#  return $self->error("tokens: " . join ", ", map "'$_'=".${$token}{$_}, keys %{$token});
  for my $band (keys %token) {
    my $debug=0;
    return $self->error("setting keys: (".
      join (", ", map "'$_'=$token{$band}{$_}", keys %{$token{$band}} ) .")")
      if $debug;
  }
  for my $band (keys %token) {
    my $bandname = $band eq '' ? "global (anon) band"  : "band '$band'";

    if (not defined $token->{$band} or $token->{$band} eq '') {
      # kludgey fixup for undefined and empty keys that should be hashrefs
      delete $token->{$band}; 
      next;
    }

    # these *must* be hashrefs so:
    return $self->error("token for $bandname must be a hashref (not '$token{$band}')") 
      unless ref ($token{$band})=~/^HASH/;

    for (keys %{$token{$band}}) {
      # these *can't* be refs (they must be scalar) so:
      return $self->error("value for token '$_' in $bandname must be scalar") 
        if ref ($token{$band}{$_})=~/^HASH/;
    }
  }

  # if we get here token HoH-ref is legal
  return 1;
}

sub error {
  my $self=shift;
  my $class=ref($self) || croak "$self is not an object";

  # if setting, sets the error attribute and returns 0 so you can:
  # return $self->error("message"); # to set the message and return 0 in one operation

  # if getting, returns the current value of $self's ->{error} 

  my $errormsg=shift or return $self->{error};

  $self->{error}=$errormsg;
  return 0; 
}

1;

__END__

=head1 NAME 

Band.pm  - Yet another perl-based HTML Template technology

=head1 DESCRIPTION

Perl CGI module useful for merging HTML from designers with dynamic perl 
data structures, using a single <--band--> tag that defines conditional and 
repeating "bands" of HTML with nested namespaces for scalar variable 
interpolation.

Band Objects allow you to define define tree structures (nested bands)
within html template files that contain conditional or repeatable html 
"bands" which include simple scalar variables expanded at run time.

=head1 SYNOPSIS

  # instantiate a new Band object
  $myskin=new Band;
  
  # initialize it with a template file (html with <!--band--> tags)
  $myskin->template(file=>$file) 
    or die "error setting template from file: '$file' - ". $myskin->error;
  
  # parse the template (validate the template syntax)
  $myskin->parse or die "error parsing template - ". $myskin->error;
  
  # assign a hash of "global" tokens to template
  $myskin->bandtoken( %token) 
    or die "can't set global band token - ".$myskin->error;
  
  # define a list of hashes to populate a repeating band
  $rows=({%row1hash}, {%row2hash}, ...);
  
  # assign the named rowset to the the template
  $myskin->rowset(myrows, @rows) or die "can't set 'myrows' list - ".$myskin->error;
  
  # print the merged results
  print "Content-Type: text/html\n\n", 
    $myskin->merge ;
  
  # to debug your template's stucture, play with this:
  print "<pre>extracting</pre>";
  print "Content-Type: text/html\n\n", 
    $myskin->source(
      with_band_tags => 1, 
      hide_implied_tags => 1, 
      htmlify => 0,
      testresults => 1, 
    #  indent => 1,
    #  show_scope=>1,
    #  show_tokens=>1,
    #  pretty =>1,
      merge =>1,
      conditional => 1,
    ); 

=head1 COPYRIGHT

    Band.pm  Version 1.00 - Yet another perl-based HTML template technology
    Copyright (C) 1999, 2000 Power Data Development

    Support, upgrades and custom implementations are available from 
    Power Data Development http://power-data.com

    Please direct inquiries about this software to program@power-data.com 
    General inquiries may be sent to info@power-data.com 

    This library is free software; you can redistribute it and/or
    modify it under the terms of the GNU Lesser General Public
    License as published by the Free Software Foundation; either
    version 2.1 of the License, or (at your option) any later version.
 
    This library is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
    Lesser General Public License for more details.
    
    You should have received a copy of the GNU Lesser General Public
    License along with this library; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

    Or you can grab a copy from http://power-data.com/lgpl-license.html

=cut