12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697989910010110210310410510610710810911011111211311411511611711811912012112212312412512612712812913013113213313413513613713813914014114214314414514614714814915015115215315415515615715815916016116216316416516616716816917017117217317417517617717817918018118218318418518618718818919019119219319419519619719819920020120220320420520620720820921021121221321421521621721821922022122222322422522622722822923023123223323423523623723823924024124224324424524624724824925025125225325425525625725825926026126226326426526626726826927027127227327427527627727827928028128228328428528628728828929029129229329429529629729829930030130230330430530630730830931031131231331431531631731831932032132232332432532632732832933033133233333433533633733833934034134234334434534634734834935035135235335435535635735835936036136236336436536636736836937037137237337437537637737837938038138238338438538638738838939039139239339439539639739839940040140240340440540640740840941041141241341441541641741841942042142242342442542642742842943043143243343443543643743843944044144244344444544644744844945045145245345445545645745845946046146246346446546646746846947047147247347447547647747847948048148248348448548648748848949049149249349449549649749849950050150250350450550650750850951051151251351451551651751851952052152252352452552652752852953053153253353453553653753853954054154254354454554654754854955055155255355455555655755855956056156256356456556656756856957057157257357457557657757857958058158258358458558658758858959059159259359459559659759859960060160260360460560660760860961061161261361461561661761861962062162262362462562662762862963063163263363463563663763863964064164264364464564664764864965065165265365465565665765865966066166266366466566666766866967067167267367467567667767867968068168268368468568668768868969069169269369469569669769869970070170270370470570670770870971071171271371471571671771871972072172272372472572672772872973073173273373473573673773873974074174274374474574674774874975075175275375475575675775875976076176276376476576676776876977077177277377477577677777877978078178278378478578678778878979079179279379479579679779879980080180280380480580680780880981081181281381481581681781881982082182282382482582682782882983083183283383483583683783883984084184284384484584684784884985085185285385485585685785885986086186286386486586686786886987087187287387487587687787887988088188288388488588688788888989089189289389489589689789889990090190290390490590690790890991091191291391491591691791891992092192292392492592692792892993093193293393493593693793893994094194294394494594694794894995095195295395495595695795895996096196296396496596696796896997097197297397497597697797897998098198298398498598698798898999099199299399499599699799899910001001100210031004100510061007100810091010101110121013101410151016101710181019102010211022102310241025102610271028102910301031103210331034103510361037103810391040104110421043104410451046104710481049105010511052105310541055105610571058105910601061106210631064106510661067106810691070107110721073107410751076107710781079108010811082108310841085108610871088108910901091109210931094109510961097109810991100110111021103110411051106110711081109111011111112111311141115111611171118111911201121112211231124112511261127112811291130113111321133113411351136113711381139114011411142114311441145114611471148114911501151115211531154115511561157115811591160116111621163116411651166116711681169117011711172117311741175117611771178117911801181118211831184118511861187118811891190119111921193119411951196119711981199120012011202120312041205120612071208120912101211121212131214121512161217121812191220122112221223122412251226122712281229123012311232123312341235123612371238123912401241124212431244124512461247124812491250125112521253125412551256125712581259126012611262126312641265126612671268126912701271127212731274127512761277127812791280128112821283128412851286128712881289129012911292129312941295129612971298129913001301130213031304130513061307130813091310131113121313131413151316131713181319132013211322132313241325132613271328132913301331133213331334133513361337133813391340134113421343134413451346134713481349135013511352135313541355135613571358135913601361136213631364136513661367136813691370137113721373137413751376137713781379138013811382138313841385138613871388138913901391139213931394139513961397139813991400140114021403140414051406140714081409141014111412141314141415141614171418141914201421142214231424142514261427142814291430143114321433143414351436143714381439144014411442144314441445144614471448144914501451145214531454145514561457145814591460146114621463146414651466146714681469147014711472147314741475147614771478147914801481148214831484148514861487148814891490149114921493149414951496149714981499150015011502150315041505150615071508150915101511151215131514151515161517151815191520152115221523152415251526152715281529153015311532153315341535153615371538153915401541154215431544154515461547154815491550155115521553155415551556155715581559156015611562156315641565156615671568156915701571157215731574157515761577157815791580158115821583158415851586158715881589159015911592159315941595159615971598159916001601160216031604160516061607160816091610161116121613161416151616161716181619162016211622162316241625162616271628162916301631163216331634163516361637163816391640164116421643164416451646164716481649165016511652165316541655165616571658165916601661166216631664166516661667166816691670167116721673167416751676167716781679168016811682168316841685168616871688168916901691169216931694169516961697169816991700170117021703170417051706170717081709171017111712171317141715171617171718171917201721172217231724172517261727172817291730173117321733173417351736173717381739174017411742174317441745174617471748174917501751175217531754175517561757175817591760176117621763176417651766176717681769177017711772177317741775177617771778177917801781178217831784178517861787178817891790179117921793179417951796179717981799180018011802180318041805180618071808180918101811181218131814181518161817181818191820182118221823182418251826182718281829183018311832183318341835183618371838183918401841184218431844184518461847184818491850185118521853185418551856185718581859186018611862186318641865186618671868186918701871187218731874187518761877187818791880188118821883188418851886188718881889189018911892189318941895189618971898189919001901190219031904190519061907190819091910191119121913191419151916191719181919192019211922192319241925192619271928192919301931193219331934193519361937193819391940194119421943194419451946194719481949195019511952195319541955195619571958195919601961196219631964196519661967196819691970197119721973 |
- package Text::Template;
- require 5.004;
- use Exporter;
- @ISA = qw(Exporter);
- @EXPORT_OK = qw(fill_in_file fill_in_string TTerror);
- use vars '$ERROR';
- use strict;
- $Text::Template::VERSION = '1.46';
- my %GLOBAL_PREPEND = ('Text::Template' => '');
- sub Version {
- $Text::Template::VERSION;
- }
- sub _param {
- my $kk;
- my ($k, %h) = @_;
- for $kk ($k, "\u$k", "\U$k", "-$k", "-\u$k", "-\U$k") {
- return $h{$kk} if exists $h{$kk};
- }
- return;
- }
- sub always_prepend
- {
- my $pack = shift;
- my $old = $GLOBAL_PREPEND{$pack};
- $GLOBAL_PREPEND{$pack} = shift;
- $old;
- }
- {
- my %LEGAL_TYPE;
- BEGIN {
- %LEGAL_TYPE = map {$_=>1} qw(FILE FILEHANDLE STRING ARRAY);
- }
- sub new {
- my $pack = shift;
- my %a = @_;
- my $stype = uc(_param('type', %a) || "FILE");
- my $source = _param('source', %a);
- my $untaint = _param('untaint', %a);
- my $prepend = _param('prepend', %a);
- my $alt_delim = _param('delimiters', %a);
- my $broken = _param('broken', %a);
- unless (defined $source) {
- require Carp;
- Carp::croak("Usage: $ {pack}::new(TYPE => ..., SOURCE => ...)");
- }
- unless ($LEGAL_TYPE{$stype}) {
- require Carp;
- Carp::croak("Illegal value `$stype' for TYPE parameter");
- }
- my $self = {TYPE => $stype,
- PREPEND => $prepend,
- UNTAINT => $untaint,
- BROKEN => $broken,
- (defined $alt_delim ? (DELIM => $alt_delim) : ()),
- };
-
-
-
-
- $self->{SOURCE} = $source;
- bless $self => $pack;
- return unless $self->_acquire_data;
-
- $self;
- }
- }
- sub _acquire_data {
- my ($self) = @_;
- my $type = $self->{TYPE};
- if ($type eq 'STRING') {
-
- } elsif ($type eq 'FILE') {
- my $data = _load_text($self->{SOURCE});
- unless (defined $data) {
-
- return undef;
- }
- if ($self->{UNTAINT} && _is_clean($self->{SOURCE})) {
- _unconditionally_untaint($data);
- }
- $self->{TYPE} = 'STRING';
- $self->{FILENAME} = $self->{SOURCE};
- $self->{SOURCE} = $data;
- } elsif ($type eq 'ARRAY') {
- $self->{TYPE} = 'STRING';
- $self->{SOURCE} = join '', @{$self->{SOURCE}};
- } elsif ($type eq 'FILEHANDLE') {
- $self->{TYPE} = 'STRING';
- local $/;
- my $fh = $self->{SOURCE};
- my $data = <$fh>;
- if ($self->{UNTAINT}) {
- _unconditionally_untaint($data);
- }
- $self->{SOURCE} = $data;
- } else {
-
-
- my $pack = ref $self;
- die "Can only acquire data for $pack objects of subtype STRING, but this is $type; aborting";
- }
- $self->{DATA_ACQUIRED} = 1;
- }
- sub source {
- my ($self) = @_;
- $self->_acquire_data unless $self->{DATA_ACQUIRED};
- return $self->{SOURCE};
- }
- sub set_source_data {
- my ($self, $newdata) = @_;
- $self->{SOURCE} = $newdata;
- $self->{DATA_ACQUIRED} = 1;
- $self->{TYPE} = 'STRING';
- 1;
- }
- sub compile {
- my $self = shift;
- return 1 if $self->{TYPE} eq 'PREPARSED';
- return undef unless $self->_acquire_data;
- unless ($self->{TYPE} eq 'STRING') {
- my $pack = ref $self;
-
-
- die "Can only compile $pack objects of subtype STRING, but this is $self->{TYPE}; aborting";
- }
- my @tokens;
- my $delim_pats = shift() || $self->{DELIM};
-
- my ($t_open, $t_close) = ('{', '}');
- my $DELIM;
- if (defined $delim_pats) {
- ($t_open, $t_close) = @$delim_pats;
- $DELIM = "(?:(?:\Q$t_open\E)|(?:\Q$t_close\E))";
- @tokens = split /($DELIM|\n)/, $self->{SOURCE};
- } else {
- @tokens = split /(\\\\(?=\\*[{}])|\\[{}]|[{}\n])/, $self->{SOURCE};
- }
- my $state = 'TEXT';
- my $depth = 0;
- my $lineno = 1;
- my @content;
- my $cur_item = '';
- my $prog_start;
- while (@tokens) {
- my $t = shift @tokens;
- next if $t eq '';
- if ($t eq $t_open) {
- if ($depth == 0) {
- push @content, [$state, $cur_item, $lineno] if $cur_item ne '';
- $cur_item = '';
- $state = 'PROG';
- $prog_start = $lineno;
- } else {
- $cur_item .= $t;
- }
- $depth++;
- } elsif ($t eq $t_close) {
- $depth--;
- if ($depth < 0) {
- $ERROR = "Unmatched close brace at line $lineno";
- return undef;
- } elsif ($depth == 0) {
- push @content, [$state, $cur_item, $prog_start] if $cur_item ne '';
- $state = 'TEXT';
- $cur_item = '';
- } else {
- $cur_item .= $t;
- }
- } elsif (!$delim_pats && $t eq '\\\\') {
- $cur_item .= '\\';
- } elsif (!$delim_pats && $t =~ /^\\([{}])$/) {
- $cur_item .= $1;
- } elsif ($t eq "\n") {
- $lineno++;
- $cur_item .= $t;
- } else {
- $cur_item .= $t;
- }
- }
- if ($state eq 'PROG') {
- $ERROR = "End of data inside program text that began at line $prog_start";
- return undef;
- } elsif ($state eq 'TEXT') {
- push @content, [$state, $cur_item, $lineno] if $cur_item ne '';
- } else {
- die "Can't happen error #1";
- }
-
- $self->{TYPE} = 'PREPARSED';
- $self->{SOURCE} = \@content;
- 1;
- }
- sub prepend_text {
- my ($self) = @_;
- my $t = $self->{PREPEND};
- unless (defined $t) {
- $t = $GLOBAL_PREPEND{ref $self};
- unless (defined $t) {
- $t = $GLOBAL_PREPEND{'Text::Template'};
- }
- }
- $self->{PREPEND} = $_[1] if $#_ >= 1;
- return $t;
- }
- sub fill_in {
- my $fi_self = shift;
- my %fi_a = @_;
- unless ($fi_self->{TYPE} eq 'PREPARSED') {
- my $delims = _param('delimiters', %fi_a);
- my @delim_arg = (defined $delims ? ($delims) : ());
- $fi_self->compile(@delim_arg)
- or return undef;
- }
- my $fi_varhash = _param('hash', %fi_a);
- my $fi_package = _param('package', %fi_a) ;
- my $fi_broken =
- _param('broken', %fi_a) || $fi_self->{BROKEN} || \&_default_broken;
- my $fi_broken_arg = _param('broken_arg', %fi_a) || [];
- my $fi_safe = _param('safe', %fi_a);
- my $fi_ofh = _param('output', %fi_a);
- my $fi_eval_package;
- my $fi_scrub_package = 0;
- my $fi_filename = _param('filename') || $fi_self->{FILENAME} || 'template';
- my $fi_prepend = _param('prepend', %fi_a);
- unless (defined $fi_prepend) {
- $fi_prepend = $fi_self->prepend_text;
- }
- if (defined $fi_safe) {
- $fi_eval_package = 'main';
- } elsif (defined $fi_package) {
- $fi_eval_package = $fi_package;
- } elsif (defined $fi_varhash) {
- $fi_eval_package = _gensym();
- $fi_scrub_package = 1;
- } else {
- $fi_eval_package = caller;
- }
- my $fi_install_package;
- if (defined $fi_varhash) {
- if (defined $fi_package) {
- $fi_install_package = $fi_package;
- } elsif (defined $fi_safe) {
- $fi_install_package = $fi_safe->root;
- } else {
- $fi_install_package = $fi_eval_package;
- }
- _install_hash($fi_varhash => $fi_install_package);
- }
- if (defined $fi_package && defined $fi_safe) {
- no strict 'refs';
-
-
- *{$fi_safe->root . '::'} = \%{$fi_package . '::'};
- }
- my $fi_r = '';
- my $fi_item;
- foreach $fi_item (@{$fi_self->{SOURCE}}) {
- my ($fi_type, $fi_text, $fi_lineno) = @$fi_item;
- if ($fi_type eq 'TEXT') {
- $fi_self->append_text_to_output(
- text => $fi_text,
- handle => $fi_ofh,
- out => \$fi_r,
- type => $fi_type,
- );
- } elsif ($fi_type eq 'PROG') {
- no strict;
- my $fi_lcomment = "#line $fi_lineno $fi_filename";
- my $fi_progtext =
- "package $fi_eval_package; $fi_prepend;\n$fi_lcomment\n$fi_text;";
- my $fi_res;
- my $fi_eval_err = '';
- if ($fi_safe) {
- $fi_safe->reval(q{undef $OUT});
- $fi_res = $fi_safe->reval($fi_progtext);
- $fi_eval_err = $@;
- my $OUT = $fi_safe->reval('$OUT');
- $fi_res = $OUT if defined $OUT;
- } else {
- my $OUT;
- $fi_res = eval $fi_progtext;
- $fi_eval_err = $@;
- $fi_res = $OUT if defined $OUT;
- }
-
-
-
- $fi_res = '' unless defined $fi_res;
- if ($fi_eval_err) {
- $fi_res = $fi_broken->(text => $fi_text,
- error => $fi_eval_err,
- lineno => $fi_lineno,
- arg => $fi_broken_arg,
- );
- if (defined $fi_res) {
- $fi_self->append_text_to_output(
- text => $fi_res,
- handle => $fi_ofh,
- out => \$fi_r,
- type => $fi_type,
- );
- } else {
- return $fi_res;
- }
- } else {
- $fi_self->append_text_to_output(
- text => $fi_res,
- handle => $fi_ofh,
- out => \$fi_r,
- type => $fi_type,
- );
- }
- } else {
- die "Can't happen error #2";
- }
- }
- _scrubpkg($fi_eval_package) if $fi_scrub_package;
- defined $fi_ofh ? 1 : $fi_r;
- }
- sub append_text_to_output {
- my ($self, %arg) = @_;
- if (defined $arg{handle}) {
- print { $arg{handle} } $arg{text};
- } else {
- ${ $arg{out} } .= $arg{text};
- }
- return;
- }
- sub fill_this_in {
- my $pack = shift;
- my $text = shift;
- my $templ = $pack->new(TYPE => 'STRING', SOURCE => $text, @_)
- or return undef;
- $templ->compile or return undef;
- my $result = $templ->fill_in(@_);
- $result;
- }
- sub fill_in_string {
- my $string = shift;
- my $package = _param('package', @_);
- push @_, 'package' => scalar(caller) unless defined $package;
- Text::Template->fill_this_in($string, @_);
- }
- sub fill_in_file {
- my $fn = shift;
- my $templ = Text::Template->new(TYPE => 'FILE', SOURCE => $fn, @_)
- or return undef;
- $templ->compile or return undef;
- my $text = $templ->fill_in(@_);
- $text;
- }
- sub _default_broken {
- my %a = @_;
- my $prog_text = $a{text};
- my $err = $a{error};
- my $lineno = $a{lineno};
- chomp $err;
- "Program fragment delivered error ``$err''";
- }
- sub _load_text {
- my $fn = shift;
- local *F;
- unless (open F, $fn) {
- $ERROR = "Couldn't open file $fn: $!";
- return undef;
- }
- local $/;
- <F>;
- }
- sub _is_clean {
- my $z;
- eval { ($z = join('', @_)), eval '#' . substr($z,0,0); 1 }
- }
- sub _unconditionally_untaint {
- for (@_) {
- ($_) = /(.*)/s;
- }
- }
- {
- my $seqno = 0;
- sub _gensym {
- __PACKAGE__ . '::GEN' . $seqno++;
- }
- sub _scrubpkg {
- my $s = shift;
- $s =~ s/^Text::Template:://;
- no strict 'refs';
- my $hash = $Text::Template::{$s."::"};
- foreach my $key (keys %$hash) {
- undef $hash->{$key};
- }
- }
- }
-
- sub _install_hash {
- my $hashlist = shift;
- my $dest = shift;
- if (UNIVERSAL::isa($hashlist, 'HASH')) {
- $hashlist = [$hashlist];
- }
- my $hash;
- foreach $hash (@$hashlist) {
- my $name;
- foreach $name (keys %$hash) {
- my $val = $hash->{$name};
- no strict 'refs';
- local *SYM = *{"$ {dest}::$name"};
- if (! defined $val) {
- delete ${"$ {dest}::"}{$name};
- } elsif (ref $val) {
- *SYM = $val;
- } else {
- *SYM = \$val;
- }
- }
- }
- }
- sub TTerror { $ERROR }
- 1;
|