File Coverage

blib/lib/Template/Plain.pm

Criterion	Covered	Total	%
statement	62	72	86.1
branch	21	30	70.0
condition	5	21	23.8
subroutine	11	11	100.0
pod	5	5	100.0
total	104	139	74.8

package Template::Plain;

use 5.006000;
use strict;
use warnings;

our $VERSION = '1.00';

# XXXXX

my $default; # Holds the default template object when class methods are used.

sub new {
  my $class = shift;
  my $content = shift || _PT_default_content();
  my $self = {
    '_delims'  => [qw/ <% %> /],
    '_content' => $content,
    '_listsep' => "\n",
  };
  bless $self, $class;
}

sub list_separator {
  my $self = shift;
  if (! ref $self) { $self = $default = $default || __PACKAGE__->new() }
  return @_ ? $self->{_listsep} = shift : $self->{_listsep};
}

sub delimiters {
  my $self = shift;
  if (! ref $self) { $self = $default = $default || __PACKAGE__->new() }
  $self->{_delims} = shift if @_ == 1;
  $self->{_delims} = [shift, shift] if @_ == 2;
  return $self->{_delims};
}

sub tags {
  my $self    = shift;
  if (! ref $self) { $self = $default = $default || __PACKAGE__->new() }
  my ($L, $R) = @{$self->{_delims}};
  my @list    = $self->{_content} =~ m/\Q$L\E\s*(.*?)\s*\Q$R\E/gm;
  return @list;
}

sub fill {
  my $self    = shift;
  if (! ref $self) { $self = $default = $default || __PACKAGE__->new() }
  my $args    = shift;
  my $replace = shift;
  my ($L, $R) = @{$self->{_delims}};
  my $text    = $self->{_content};
  $text =~ s/\Q$L\E\s*(.*?)\s*\Q$R\E/$self->_expand($1,$args)/egm;
  $self->{_content} = $text if $replace;
  return \$text;
}


# Private Methods

sub _expand {
  my $self = shift;
  my ($key, $hashr) = @_;
  my $value = $hashr->{$key};

  return '' unless defined $value;

  for (ref $value) {
    /CODE/   and do { return $value->() };
    /ARRAY/  and do { return join $self->{_listsep}, @$value };
    /SCALAR/ and do { return $$value };
    /^$/     and do { return $value };
  }
}



# Private class methods

sub _PT_default_content {

  my $FH;
  my $pkg = caller;

  no strict 'refs';

  # if DATA exists in the calling package use that.
  if ( exists ${ $pkg . '::' }{DATA} and defined *{${$pkg . '::'}{DATA}}{IO}) {
    $FH = *{${$pkg . '::'}{DATA}}{IO};

  # else if DATA exists in main, use that.
  } elsif ( exists $main::{DATA} and defined *main::DATA{IO} ){
    $FH = *main::DATA{IO};

  # else use <>
  } else {
    $FH = \*ARGV;
  }

  do { undef $/; <$FH> };

}

################################################################################
1;

__END__