view release on metacpan or  search on metacpan

lib/HTML/YaTmpl.pm  view on Meta::CPAN

use IO::File ();
use File::Spec ();
use Errno ();
use Compress::Zlib ();

our $VERSION='1.8';
our @CLASS_MEMBERS;

#$SIG{INT}=sub {
#  use Carp 'cluck';
#  cluck "SIGINT\n";
#};

sub clear_errors {
  my $rc=$_[0]->errors;
  $_[0]->errors=[];
  return @{$rc};
}

sub _report_error {
  my $I=shift;
  my $eval=shift;
  my $x=join( ' ', 'ERROR', length $I->eprefix?$I->eprefix:() ).' ';
  if( length( $eval ) ) {
    if( $@=~/\bline \d+\b/ ) {
      my $nr=2;
      $eval=~s/\n/sprintf "\n%04d: ", $nr++/ge;
      $x.="while eval( \n0001: $eval\n): ";
    } else {
      $x.="while eval( $eval ): ";
    }
  } else {
    $x.=": ";
  }
  $x.=shift || $@;

  push @{$I->errors}, $x;
  die $x."\n" if( $I->onerror eq 'die' );
  return $x if( $I->onerror eq 'output' );
  return $I->onerror->( $x ) if( ref($I->onerror) eq 'CODE' );
  warn $x if( $I->onerror eq 'warn' );
  return '';
}

sub new {
  my $parent=shift;
  my $class=ref($parent) || $parent;
  my $I=bless {}=>$class;
  my %o=@_;

  if( ref($parent) ) {
    foreach my $m (@CLASS_MEMBERS) {
      $I->$m=$parent->$m;
    }
  } else {
    if( exists $ENV{HTML_TMPL_SEARCH_PATH} ) {
      my $sep=$Config{path_sep} || ':';
      $I->path=[split $sep, $ENV{HTML_TMPL_SEARCH_PATH}];
    }
  }
  $I->package=(caller)[0];
  $I->errors=[];
  foreach my $m (@CLASS_MEMBERS) {
    $I->$m=$o{$m} if( exists $o{$m} );
  }

  length $I->file and return $I->open;

  return $I;
}

sub open {
  my $I=shift;
  my %o=@_;

  $I->file=$o{file} if( exists $o{file} );
  $I->path=$o{path} if( exists $o{path} );
  local *F;
  local $/;
  if( -d $I->file ) {
    (exists($!{EISDIR}) and $!=&Errno::EISDIR) or
    (exists($!{EACCES}) and $!=&Errno::EACCES);
    return;
  }
  open F, '<'.$I->file or do {
    my $rc=0;
    unless( File::Spec->file_name_is_absolute( $I->file ) ) {
      foreach my $el (@{$I->path||[]}) {
	next unless( length $el );
	$el=~s!/*$!!;		# strip trailing slash if any
	my $f=File::Spec->catfile( $el, $I->file );
	if( -d $f ) {
	  (exists($!{EISDIR}) and $!=&Errno::EISDIR) or
	  (exists($!{EACCES}) and $!=&Errno::EACCES);
	  last;
	} elsif( open F, '<'.$f ) {
	  $rc=1;
	  last;
	}
      }
    }
    $rc;
  } or return;

  $I->template=<F>;
  close F;
  return unless( defined $I->template );
  return $I;
}

sub _param {
  my $name=shift;
  my $el=shift;

  foreach my $p (reverse @{$el->[2]}) {
    return $p->[1] if( ref $p eq 'ARRAY' and lc($p->[0]) eq $name );
  }
  return;
}

sub _fill_in {