File Coverage

blib/lib/Mail/Salsa/Template.pm

Criterion	Covered	Total	%
statement	12	54	22.2
branch	0	8	0.0
condition	0	3	0.0
subroutine	4	9	44.4
pod	0	5	0.0
total	16	79	20.2

#
# Mail/Salsa/Template.pm
# Last Modification: Sat Oct 29 20:23:23 WEST 2005
#
# Copyright (c) 2005 Henrique Dias . All rights reserved.
# This module is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
package Mail::Salsa::Template;

use 5.008000;
use strict;
use warnings;

require Exporter;
use AutoLoader qw(AUTOLOAD);

our @ISA = qw(Exporter);

# Items to export into callers namespace by default. Note: do not export
# names by default without a very good reason. Use EXPORT_OK instead.
# Do not simply export all your public functions/methods/constants.

# This allows declaration	use Mail::Salsa::Template ':all';
# If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
# will save memory.

our %EXPORT_TAGS = ( 'all' => [ qw() ] );
our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
our @EXPORT = qw();

our $VERSION = '0.02';

# Preloaded methods go here.

# Autoload methods go after =cut, and are processed by the autosplit program.

sub new {
	my $proto = shift;
	my $class = ref($proto) || $proto;
	my $self  = {
		'lang'  => "en",
		'label' => "",
		'outfh' => undef,
		'infh'  => undef,
		@_,
	};
	bless ($self, $class);
	$self->init();
	return($self);
}

sub init {
	my $self = shift;

	my $label = $self->{'label'};
	for(0..1) {
		my $lang = uc($self->{'lang'});
		my $module = "use Mail::Salsa::Lang::$lang qw(insidefh);\n";
		eval($module);
		($@) ? ($self->{'lang'} = "en") : last;
	}
	$self->{'infh'} = insidefh();
	return();
}

sub filehandle {
	my $self = shift;
	$self->{'outfh'} = shift;
	return();
}

sub label {
	my $self = shift;
	$self->{'label'} = shift;
	return();
}

sub replace {
	my $self = shift;
	my $vars = {@_};

	my $label = $self->{'label'};
	my $infh = $self->{'infh'};
	my $outfh = $self->{'outfh'};

	my $evalcode = "";
	for my $key (keys(%{$vars})) {
		my $val = $vars->{$key};
		$val =~ s/\@/\\@/g;
		$evalcode .= "s{\\\$$key\\b}{$val}g;\n";
	}
	my $msg = 0;
	while(<$infh>) {
		if($msg) {
			last if(/^\<\/template\>[\n\r]+/);
			eval($evalcode);
			s{^\.}{\.\.};
			print $outfh $_;
			next;
		}
		$msg = 1 if(/^\< *template +name=\"$label\" *\>[\n\r]+/);
	}
	return();
}

1;
__END__