Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

PodMaster's scratchpad

by PodMaster (Abbot)
on Jun 01, 2004 at 18:22 UTC ( [id://358353]=scratchpad: print w/replies, xml ) Need Help??

=head1 Storable 2.15 has a memory leak Here's how I discovered it. First you go to where cpanplus keeps its configuration info (the .cpanplus directory) $cpanplusconf->{conf}{base} and delete the sourcefiles.*.stored file C:\Perl\.cpanplus>perl -e"die time" 1117533963 at -e line 1. C:\Perl\.cpanplus>cpanp CPANPLUS::Shell::Default -- CPAN exploration and modules installat +ion (v0.053) *** Please report bugs to <cpanplus-bugs@lists.sourceforge.net>. *** Using CPANPLUS::Backend v0.053. ReadLine support disabled. CPAN Terminal> l CGI Details for 'CGI' Author Lincoln D. Stein (lstein@cshl.org) Description None given Development Stage Unknown Interface Style Unknown Language Used Unknown Package CGI.pm-3.10.tar.gz Public License Unknown Support Level Unknown Version Installed 3.10 Version on CPAN 3.10 Contains: CGI CGI::Carp CGI::Cookie CGI::Fast CGI::Pretty CGI::Push CGI::Util CPAN Terminal> q Exiting CPANPLUS shell C:\Perl\.cpanplus> C:\Perl\.cpanplus>perl -e"die time" 1117533981 at -e line 1. C:\Perl\.cpanplus>perl -e"die 1117533981-1117533963" 18 at -e line 1. C:\Perl\.cpanplus>dir *stored 05/31/2005 03:06 AM 14,631,498 sourcefiles.2.15.stored This is cool (18 seconds), but if you repeat these steps, cpanp will +load sourcefiles.2.15.stored, but quitting will take a very very long time, eating %100 of the CPU, and increasingly more and more memory. I quit after the first time. I've traced through CPANPLUS, and it is the call to Storable::nstore that is to blame. =cut #use Pod::Usage;pod2usage(-verbose => 2); print "you should chdir where CPANPLUS keeps sourcefiles*.stored$/"; print "which is something like \$cpanplusconf->{conf}{base}$/"; print "and delete the sourcefiles.*.stored file$/"; print "This should take a short time (under a minute)$/"; my $now = time; system qw[ perl -S cpanp l CGI]; print time-$now,$/,$/; print $_,$/ for glob 'sourcefiles*.stored'; print "This should take a long time (many minutes)$/and leak memory$/" +; $now = time; system qw[ perl -S cpanp l CGI]; print time-$now,$/,$/;





use Benchmark 'cmpthese'; my %hash = ( 1 .. 666 ); cmpthese( -3, { 'for' => sub { for my $i ( keys %hash ) { my $c = $hash{$i}; } return(); }, 'while' => sub { while( my( $k, $v ) = each %hash ){ my $c = $v; # yeah; } return(); }, }); __END__ Benchmark: running for, while, each for at least 3 CPU seconds... for: 3 wallclock secs ( 3.27 usr + 0.00 sys = 3.27 CPU) @ 35 +60.93/s (n=11630) while: 3 wallclock secs ( 3.13 usr + 0.00 sys = 3.13 CPU) @ 26 +40.96/s (n=8253) Rate while for while 2641/s -- -26% for 3561/s 35% -- Benchmark: running for, while, each for at least 3 CPU seconds... for: 4 wallclock secs ( 3.30 usr + 0.00 sys = 3.30 CPU) @ 35 +27.45/s (n=11630) while: 3 wallclock secs ( 3.37 usr + 0.00 sys = 3.37 CPU) @ 24 +52.74/s (n=8278) Rate while for while 2453/s -- -30% for 3527/s 44% --
sulfericacid
#!perl #!/usr/bin/perl # uncomment if you wanna keep your own log (sucky ISP) # in the same directory as your program #BEGIN { # use CGI::Carp qw[ carpout ]; # carpout(\*LOGGY) if open(LOGGY,'>'.__FILE__.'.log'); #} use CGI::Carp qw[ fatalsToBrowser ]; use CGI 2.7; # use at least version 2.7 of CGI use CGI qw[ -nosticky -no_undef_params ]; $CGI::DISABLE_UPLOADS = 'yes'; $CGI::DISABLE_UPLOADS = 1; use strict; ## you may not have warnings installed, so watchout use warnings; no warnings 'uninitialized'; # not that we'd have any (anymore) my $query = CGI->new; my $message = $query->param("message") || ''; my $method = $query->param("method") || ''; $query->delete_all(); print $query->header, $query->a( { href => $query->url(-absolute=>1) .'?' .$$ .time() .rand() }, $query->url(), ), $query->h1("method: $method"), $query->h1("message: $message"), $query->h1("what you wanna do?"), $query->start_html(), $query->start_form(); if ( $method eq 'encode' ) { $method = 'decode'; $message = join ' ', unpack("C*", "$message"); } elsif ( $method eq 'decode') { $method = 'encode'; $message = pack("C*", split ' ', $message); } else { $method = 'encode'; $message = 'a sample message'; } print $query->radio_group( -name => 'method', -values => [ 'encode', 'decode'], -default => $method, ), $query->hr(), $query->textarea( -name => 'message', -rows => 10, -cols => 80, -value => $message, ), $query->hr(), $query->submit(), $query->end_form(), $query->end_html(); __END__
Rubber Biscuit!!!
use Data::Dumper; use LWP::Simple; use strict; my $html = get q[http://javajunkies.org/index.pl?node=login]; use HTML::LinkExtractor; { my $lX = HTML::LinkExtractor->new(); $lX->parse(\$html); for( @{ $lX->links() } ){ print Dumper($_) if $_->{tag} =~ /meta/; } } use HTML::TokeParser::Simple; { my $tS = HTML::TokeParser::Simple->new(\$html); while(my $t = $tS->get_tag('meta')){ print Dumper( $t->return_attr ); } } use HTML::Parser; { my $p = HTML::Parser->new( api_version => 3, start_h => [ sub { print Dumper($_[-1]) if $_[-2] eq 'meta'; }, "tagname, attr" ], ); $p->parse($html); } use HTML::TreeBuilder; { for my $meta ( HTML::TreeBuilder->new_from_content($html)->find_by +_tag_name('meta') ) { print Dumper( $meta->all_external_attr ); } } __END__ $VAR1 = { 'content' => 'A community committed to sharing Java knowledg +e and coding tips. The site contains questions and answers, useful s +nippets, and a library of code.', 'tag' => 'meta', 'name' => 'description' }; $VAR1 = { 'content' => 'programming, learning, tutorials, questions, a +nswers, examples, java FAQ, code, java, java discussion, java help, j +ava community, java problems', 'tag' => 'meta', 'name' => 'keywords' }; $VAR1 = { 'content' => 'A community committed to sharing Java knowledg +e and coding tips. The site contains questions and answers, useful s +nippets, and a library of code.', 'name' => 'description' }; $VAR1 = { 'content' => 'programming, learning, tutorials, questions, a +nswers, examples, java FAQ, code, java, java discussion, java help, j +ava community, java problems', 'name' => 'keywords' }; $VAR1 = { 'content' => 'A community committed to sharing Java knowledg +e and coding tips. The site contains questions and answers, useful s +nippets, and a library of code.', 'name' => 'description' }; $VAR1 = { 'content' => 'programming, learning, tutorials, questions, a +nswers, examples, java FAQ, code, java, java discussion, java help, j +ava community, java problems', 'name' => 'keywords' }; $VAR1 = 'content'; $VAR2 = 'A community committed to sharing Java knowledge and coding ti +ps. The site contains questions and answers, useful snippets, and a +library of code.'; $VAR3 = 'name'; $VAR4 = 'description'; $VAR1 = 'content'; $VAR2 = 'programming, learning, tutorials, questions, answers, example +s, java FAQ, code, java, java discussion, java help, java community, +java problems'; $VAR3 = 'name'; $VAR4 = 'keywords';

Here is a patch for a think-o in XRCed-0.0.8-1 A toolbar can be embedded in a panel/frame. cjf-II:

use Benchmark 'cmpthese'; my $oy = 'a'x999; cmpthese( -3, { split => sub { my $str = $oy; my @b = split//,$str; }, subst => sub { my $str = $oy; my @b; while(length $str){ push @b, substr($str,0,1,undef); } }, match => sub { my $str = $oy; my @b = $str =~ /(.)/g; } }); __END__ Benchmark: running match, split, subst, each for at least 3 CPU second +s... match: 3 wallclock secs ( 3.28 usr + 0.00 sys = 3.28 CPU) @ 15 +87.14/s (n=5209) split: 3 wallclock secs ( 3.31 usr + 0.00 sys = 3.31 CPU) @ 15 +63.71/s (n=5179) subst: 4 wallclock secs ( 3.28 usr + 0.00 sys = 3.28 CPU) @ 11 +31.67/s (n=3713) Rate subst split match subst 1132/s -- -28% -29% split 1564/s 38% -- -1% match 1587/s 40% 1% --
gnangia:
# JavaScript-SpiderMonkey-0.08/Makefile.PL use ExtUtils::MakeMaker; use File::Copy qw( cp ); WriteMakefile( 'NAME' => 'JavaScript::SpiderMonkey', 'VERSION_FROM' => 'SpiderMonkey.pm', ( $] >= 5.005 ? ( ABSTRACT_FROM => 'SpiderMonkey.pm', AUTHOR => 'Mike <mschilli@noevalley.com>') : () ), 'LIBS' => ' -L../js/src/Debug -ljs32 ', 'DEFINE' => '-DXP_PC', #or -DXP_UNIX 'INC' => "-I../js -I../js/src -I../js/src/Debug", 'OBJECT' => '../js/src/Debug/*.lib $(O_FILES)', ) and # copy the dll to where SpiderMonkey.dll can find it for the test print " cp( '../js/src/Debug/js32.dll', './blib/arch/auto/JavaScript/SpiderMonkey/js32.dll'); 0 or 1: ", cp( '../js/src/Debug/js32.dll', './blib/arch/auto/JavaScript/SpiderMonkey/js32.dll'); __END__ Download these two files in the same directory: js-1.5-rc4a.tar.gz JavaScript-SpiderMonkey-0.08.tar.gz Then go to a commandline and execute these commands: gzip -cd js-1.5-rc4a.tar.gz |tar -xv cd js\src\ nmake -f js.mak cd ..\.. gzip -cd JavaScript-SpiderMonkey-0.08.tar.gz |tar -xv cd JavaScript-SpiderMonkey-0.08 perl Makefile.PL nmake nmake test nmake install
Ovid, dunno why you'd want to see this, but here goes
use strict; use warnings; use HTML::TokeParser::Simple; use Data::Dumper 'DumperX'; my $p = HTML::TokeParser::Simple->new( \*DATA ); my $daFile = ""; while ( my $t = $p->get_token ) { $daFile .= $t->return_text; if( $t->is_start_tag('font')) { local $SIG{__DIE__} = sub { print STDERR @_; print STDERR "\n",'x'x69,"\n"; print STDERR "\n$daFile\n"; print STDERR "\n",'x'x69,"\n"; print STDERR DumperX($t); exit 1; }; ## RETARDATION ($t is a token, not a parser) $t->get_trimmed_text('/font'); } } __END__ <table width=90 bgcolor="#ffffff" cellpadding=0 cellspacing=0 border=0 +> <td width=90 height=26 bgcolor="#999999" align=center class="buttonoff +" nowrap onmouseover="this.className='buttonon'" onmousedown="this.c +lassName='buttondown'" onmouseout="this.className='buttonoff'" onclick="window.location=' +default.html'"><font face="arial, geneva, helvetica" size="-1">
guha
#!/usr/bin/perl -wl use strict; #use re 'eval'; $\= "\n"; my $qred = qr{ MT: (\")? ([^\"]+) (?(1) \"\s | \s) }x; for( ' MT:yes ' , 'MT:NO" ', 'MT:"yes" ', 'MT:"NO ' ) { print; print $2 if /$qred/; print '-' x 33; } eval q{ require YAPE::Regex::Explain; print YAPE::Regex::Explain->new($qred)->explain; }; __END__ MT:yes yes --------------------------------- MT:NO" --------------------------------- MT:"yes" yes --------------------------------- MT:"NO --------------------------------- The regular expression: (?x-ims: MT: (")? ([^"]+) (?(1) "\s | \s) ) matches as follows: NODE EXPLANATION ---------------------------------------------------------------------- (?x-ims: group, but do not capture (disregarding whitespace and comments) (case-sensitive) (with ^ and $ matching normally) (with . not matching \n): ---------------------------------------------------------------------- MT: 'MT:' ---------------------------------------------------------------------- ( group and capture to \1 (optional (matching the most amount possible)): ---------------------------------------------------------------------- " '"' ---------------------------------------------------------------------- )? end of \1 (NOTE: because you're using a quantifier on this capture, only the LAST repetition of the captured pattern will be stored in \1) ---------------------------------------------------------------------- ( group and capture to \2: ---------------------------------------------------------------------- [^"]+ any character except: '"' (1 or more times (matching the most amount possible)) ---------------------------------------------------------------------- ) end of \2 ---------------------------------------------------------------------- (?(1) if back-reference \1 matched, then: ---------------------------------------------------------------------- " '"' ---------------------------------------------------------------------- \s whitespace (\n, \r, \t, \f, and " ") ---------------------------------------------------------------------- | else: ---------------------------------------------------------------------- \s whitespace (\n, \r, \t, \f, and " ") ---------------------------------------------------------------------- ) end of conditional on \1 ---------------------------------------------------------------------- ) end of grouping ----------------------------------------------------------------------
use Benchmark qw( cmpthese ); cmpthese( -3, { del => sub { my @B = (1..100); delete @B[0,-1]; }, shiftNpop => sub { my @B = (1..100); shift @B; pop @B; }, sliceAssi => sub { my @B = (1..100); @B = @B[1..$#B-1]; }, splice => sub { my @B = (1..100); splice @B,0,1; splice @B,-1; } }); __END__ Benchmark: running del, shiftNpop, sliceAssi, splice, each for at leas +t 3 CPU seconds... del: 4 wallclock secs ( 3.08 usr + 0.00 sys = 3.08 CPU) @ 67 +710.85/s (n=208414) shiftNpop: 3 wallclock secs ( 3.06 usr + 0.00 sys = 3.06 CPU) @ 68 +042.44/s (n=208414) sliceAssi: 3 wallclock secs ( 3.20 usr + 0.00 sys = 3.20 CPU) @ 18 +594.44/s (n=59558) splice: 3 wallclock secs ( 3.09 usr + 0.00 sys = 3.09 CPU) @ 67 +360.70/s (n=208414) Rate sliceAssi splice del shiftNpop sliceAssi 18594/s -- -72% -73% -73% splice 67361/s 262% -- -1% -1% del 67711/s 264% 1% -- -0% shiftNpop 68042/s 266% 1% 0% --
andreychek
# this makes a little sense package PUTTY; use CGI; sub new { return bless {}, shift; } sub loaded_plugins { qw( get_A get_B ) }; # when use PUTTY; is done, $a and $b get instantiated # and can be shared among all instances of PUTTY via $self->get_A # or simply PUTTY->get_A { my $a = new CGI; sub get_A { return $a; } my $b = new CGI; sub get_B { return $b; } } 1; package main; my $self = new PUTTY(); my $other = new PUTTY(); for my $plugin ( $self->loaded_plugins() ) { print $self->$plugin,"\n", PUTTY->$plugin,"\n", $other->$plugin,"\n\n"; }

hacker
foreach (@body) { chomp $_; next if /^#/; if( m{(.*?<template>)(.*)} ) { push @unwrappeddata, $2; $line = $1; }elsif( m{(.*?)(</template>.*)} ) { push @unwrappeddata, $1; $line = $2; last; }elsif(@unwrappeddata) { # we're in between template if (m/^[^\s=]+\s+=\s*/ || m/^\[.*\]$/) { $line =~ s/^#/\n#/m; $line .= "\n"; push @unwrappeddata, $line; $line = $_; } else { $line .= $_; } } }
#!/usr/bin/perl use strict; use warnings; use Benchmark qw( cmpthese ); # this benchmark is a little naive, but glob is slower anyway my %Subs = ( tyeglob => sub { my $count = () = glob "*.pl*"; }, glob => sub { my $count = () = <*.pl*>; # scalar glob returns a file, d'oh }, readdir => sub { opendir(DIR,'.') or die $!; my $count = 0; while( $_ = readdir(DIR) ) { $count++ if /^.*?\.pl.*$/i; } closedir(DIR); }, readgrep => sub { opendir(DIR,'.') or die $!; my $count = scalar( grep {/^.*?\.pl.*/i} readdir(DIR)); closedir(DIR); }, ); cmpthese( -3, \%Subs ) unless @ARGV; if(@ARGV){ print "$_ ".$Subs{$_}->()."\n" for keys %Subs; } __END__ Benchmark: running glob, readdir, readgrep, tyeglob, each for at least + 3 CPU seconds... glob: 3 wallclock secs ( 3.36 usr + 0.00 sys = 3.36 CPU) @ 40 +7.14/s (n=1368) readdir: 4 wallclock secs ( 3.41 usr + 0.00 sys = 3.41 CPU) @ 88 +9.44/s (n=3033) readgrep: 3 wallclock secs ( 3.30 usr + 0.00 sys = 3.30 CPU) @ 10 +58.48/s (n=3493) tyeglob: 3 wallclock secs ( 3.24 usr + 0.00 sys = 3.24 CPU) @ 40 +3.40/s (n=1307) Rate tyeglob glob readdir readgrep tyeglob 403/s -- -1% -55% -62% glob 407/s 1% -- -54% -62% readdir 889/s 120% 118% -- -16% readgrep 1058/s 162% 160% 19% -- Benchmark: running glob, readdir, readgrep, tyeglob, each for at least + 3 CPU seconds... glob: 4 wallclock secs ( 3.07 usr + 0.00 sys = 3.07 CPU) @ 40 +3.91/s (n=1240) readdir: 4 wallclock secs ( 3.57 usr + 0.00 sys = 3.57 CPU) @ 84 +9.58/s (n=3033) readgrep: 4 wallclock secs ( 3.41 usr + 0.00 sys = 3.41 CPU) @ 10 +24.34/s (n=3493) tyeglob: 4 wallclock secs ( 3.30 usr + 0.00 sys = 3.30 CPU) @ 39 +6.97/s (n=1310) Rate tyeglob glob readdir readgrep tyeglob 397/s -- -2% -53% -61% glob 404/s 2% -- -52% -61% readdir 850/s 114% 110% -- -17% readgrep 1024/s 158% 154% 21% --
sub isleap { my ($year) = @_; return 1 if (( $year % 400 ) == 0 ); # 400's are leap return 0 if (( $year % 100 ) == 0 ); # Other centuries are not return 1 if (( $year % 4 ) == 0 ); # All other 4's are leap return 0; # Everything else is not } sub isLeap { my $Y=shift; return $Y % 400 ?( $Y % 100 ?( $Y % 4 ? 0 : +1 ): 0 ): 1; } =head1 C<isLeap> explained Get it? What else is there to explain ;)(it's isleap reduced to using +?:) =cut for my $year( 1980..1994) { printf "%10.10s | %s | %s\n", $year, isleap( $year ), isLeap( $year ); } __END__ 1980 | 1 | 1 1981 | 0 | 0 1982 | 0 | 0 1983 | 0 | 0 1984 | 1 | 1 1985 | 0 | 0 1986 | 0 | 0 1987 | 0 | 0 1988 | 1 | 1 1989 | 0 | 0 1990 | 0 | 0 1991 | 0 | 0 1992 | 1 | 1 1993 | 0 | 0 1994 | 0 | 0 and now for the butter __END__ E:\new\Date-Leapyear-1.71>ls ChangeLog LICENSE MANIFEST Makefile.PL Makefile.old README lib +t E:\new\Date-Leapyear-1.71>perl Makefile.PL Checking if your kit is complete... Looks good Writing Makefile for Date::Leapyear E:\new\Date-Leapyear-1.71>nmake Microsoft (R) Program Maintenance Utility Version 6.00.8168.0 Copyright (C) Microsoft Corp 1988-1998. All rights reserved. cp lib/Date/Leapyear.pm blib\lib\Date\Leapyear.pm E:\new\Date-Leapyear-1.71>nmake test Microsoft (R) Program Maintenance Utility Version 6.00.8168.0 Copyright (C) Microsoft Corp 1988-1998. All rights reserved. C:\Perl\bin\perl.exe -Mblib -IC:\Perl\lib -IC:\Perl\lib -e "us +e Test::Harness qw(&runtests $verbose); $verbose=0 ; runtests @ARGV;" t\00load.t t\01isleap.t t\02testmore.t Using E:/new/Date-Leapyear-1.71/blib t\00load........ok t\01isleap......ok t\02testmore....ok All tests successful. Files=3, Tests=764, 0 wallclock secs ( 0.00 cusr + 0.00 csys = 0.00 + CPU) E:\new\Date-Leapyear-1.71>cat MANIFEST lib/Date/Leapyear.pm MANIFEST Makefile.PL README ChangeLog LICENSE t/00load.t t/01isleap.t t/02testmore.t E:\new\Date-Leapyear-1.71>cat Makefile.PL use ExtUtils::MakeMaker; # See lib/ExtUtils/MakeMaker.pm for details of how to influence # the contents of the Makefile that is written. WriteMakefile( 'NAME' => 'Date::Leapyear', 'VERSION_FROM' => 'lib/Date/Leapyear.pm', # finds $VERSION 'PREREQ_PM' => { 'Test::More' => 0, }, # e.g., Module::Name => 1.1 ); E:\new\Date-Leapyear-1.71>
HTML::Templates author is samtregar don't ya know.

use strict; use Data::Dumper; use HTML::Template; warn $INC{'HTML/Template.pm'}; my ($output, $template, $result); $template = HTML::Template->new_scalar_ref( \q{ <TMPL_LOOP NO_NAME_LOOP> #Q: <TMPL_VAR 0> ? #a) <TMPL_VAR 1> #b) <TMPL_VAR 2> #c) <TMPL_VAR 3> #d) <TMPL_VAR 4> </TMPL_LOOP> }, debug => 1, # memory_debug => 1, ); $template->param( NO_NAME_LOOP => [ map { my %H; my $c=$_; $H{$_}= $c->[$_] for 0..$#$_; \%H; } [ Hello => hello => goodbye => biscuits => 'What??!' ], [ Tacos => yes => please => no => 3 ], [ 'Smell That', yes => hmmm => 'Tacos?' => 'noxious' ], [ qw{ rubber baby buggy bumpers rock } ], ], ); $output = $template->output; print $output; print Dumper($template); =pod Initially, I wanted to be was gonna patch this thing to accept input in param exactly as above, minus that little map statement. It turns out it's WAAAAAAAAAAAAAAAAAAAAAY too much work, for BEYOND NO BENEFIT. I'll just stick with that little map statement fol +ks. On the other hand, I did get tired of saying <TMPL_VAR 1> <TMPL_VAR 2> ... So now the patch I suppose to write is one that would, after encounter +ing <TMPL_VAR> <TMPL_VAR> automagically generate the param'var's 1 and 2, as opposed to creating + '' which is real stupid if you ask me So it looks like i gotta patch sub _parse BTW ~ if I "eval" that Dumper output, and call $VAR1->output HTML::Template throws HTML::Template->output() : fatal error in loop output : HTML::Template::param() : attempt to set parameter '0' with a scalar - parameter is not a TMPL_VAR! at C:/Perl/site/lib/HTML/Template.pm line 2789 Wassup???? =cut

WHOHOHOOOOOOOOOOOOOOOOOOOOOOOOOOA!!!!

WHOOOOOOOOOOOOOOOOA! If you like or think what you see below is interesting, download it and run test3.pl to see for yourself. The patch wasn't that painful after all.

use strict; use Data::Dumper; $Data::Dumper::Indent=1; $Data::Dumper::Indent=1; use blib; use HTML::Template; warn $INC{'HTML/Template.pm'}; my ($output, $template, $result); ## apparently, a <TMPL_VAR> creates 5 of a '' kind ## maybe i should like a <TMPL_LOOP ARAYYO=1 NO_NAME_NEW_KIND_LOOP> ## but anyway, mission 1, make _parse parse it right ## (IGNORE THE DEBUG VARS IN THE TEMPLATE for now) $template = HTML::Template->new_scalar_ref( \q{ <TMPL_LOOP NO_NAME_LOOP> #Q: <TMPL_VAR> ? #a) <TMPL_VAR> #b) <TMPL_VAR> #c) <TMPL_VAR> #d) <TMPL_VAR> </TMPL_LOOP> }, debug => 1, # memory_debug => 1, ); #print Dumper($template); $output = ### THIS IS THE OUTPUT I EXPECT '#Q: Hello ? #a) hello #b) goodbye #c) biscuits #d) What??! #Q: Tacos ? #a) yes #b) please #c) no #d) 1 #Q: Smell That ? #a) yes #b) hmmm #c) Tacos? #d) noxious #Q: rubber ? #a) baby #b) buggy #c) bumpers #d) rock '; ## param will die, as it don't know what to do ... YET! $template->param( NO_NAME_LOOP => [ [ Hello => hello => goodbye => biscuits => 'What??!' ], [ Tacos => yes => please => no => 1 ], [ 'Smell That', yes => hmmm => 'Tacos?' => 'noxious' ], [ qw{ rubber baby buggy bumpers rock } ], ], ); $output = $template->output; print $output; $template = HTML::Template->new_scalar_ref( \q{ <TMPL_LOOP NO_NAME_LOOP> a: <TMPL_VAR> b: <TMPL_VAR> <TMPL_LOOP NO_NAME_LOOP_A_NEW> A: <TMPL_VAR> B: <TMPL_VAR> </TMPL_LOOP> </TMPL_LOOP> }, debug => 1, # memory_debug => 1, ); #print Dumper $template; $template->param( NO_NAME_LOOP => [ [ 'ABE', 'LINCOLN' ], { 0 => 'BOO', 1 => 'BAH', NO_NAME_LOOP_A_NEW => [ [ 'AGAIN', 'ONCE MORE' ], [ 'NO', ' MORE' ], ] }, { 0 => 'GEORGE', 1 => 'CLOONEY', NO_NAME_LOOP_A_NEW => [ { 0 => 'SUCKS', 1 => 'ROCKS', }, { 0 => 'REAL', 1 => 'BAD', } ] } ], ); $output = $template->output; print $output; ## THIS IS ILLEGAL, a nameless TMPL_VAR outside of a LOOP $template = HTML::Template->new_scalar_ref( \q{ <TMPL_VAR> <TMPL_VAR> <TMPL_VAR> }, debug => 1, # memory_debug => 1, ); __END__ ### HTML::Template Debug ### In _parse: ### HTML::Template Debug ### /*IN_MEMORY*/ : line 2 : LOOP no_name_loo +p start ### HTML::Template Debug ### /*IN_MEMORY*/ : line 3 : parsed VAR 0 ### HTML::Template Debug ### /*IN_MEMORY*/ : line 4 : parsed VAR 1 ### HTML::Template Debug ### /*IN_MEMORY*/ : line 5 : parsed VAR 2 ### HTML::Template Debug ### /*IN_MEMORY*/ : line 6 : parsed VAR 3 ### HTML::Template Debug ### /*IN_MEMORY*/ : line 7 : parsed VAR 4 ### HTML::Template Debug ### /*IN_MEMORY*/ : line 9 : LOOP end ### HTML::Template Debug ### In output ### HTML::Template Debug ### In output ### HTML::Template Debug ### In output ### HTML::Template Debug ### In output ### HTML::Template Debug ### In output #Q: Hello ? #a) hello #b) goodbye #c) biscuits #d) What??! #Q: Tacos ? #a) yes #b) please #c) no #d) 1 #Q: Smell That ? #a) yes #b) hmmm #c) Tacos? #d) noxious #Q: rubber ? #a) baby #b) buggy #c) bumpers #d) rock ### HTML::Template Debug ### In _parse: ### HTML::Template Debug ### /*IN_MEMORY*/ : line 2 : LOOP no_name_loo +p start ### HTML::Template Debug ### /*IN_MEMORY*/ : line 3 : parsed VAR 0 ### HTML::Template Debug ### /*IN_MEMORY*/ : line 4 : parsed VAR 1 ### HTML::Template Debug ### /*IN_MEMORY*/ : line 5 : LOOP no_name_loo +p_a_new start ### HTML::Template Debug ### /*IN_MEMORY*/ : line 6 : parsed VAR 0 ### HTML::Template Debug ### /*IN_MEMORY*/ : line 7 : parsed VAR 1 ### HTML::Template Debug ### /*IN_MEMORY*/ : line 8 : LOOP end ### HTML::Template Debug ### /*IN_MEMORY*/ : line 9 : LOOP end ### HTML::Template Debug ### In output ### HTML::Template Debug ### In output ### HTML::Template Debug ### In output ### HTML::Template Debug ### In output ### HTML::Template Debug ### In output ### HTML::Template Debug ### In output ### HTML::Template Debug ### In output ### HTML::Template Debug ### In output a: ABE b: LINCOLN a: BOO b: BAH A: AGAIN B: ONCE MORE A: NO B: MORE a: GEORGE b: CLOONEY A: SUCKS B: ROCKS A: REAL B: BAD ### HTML::Template Debug ### In _parse: HTML::Template->new() : No NAME given to a TMPL_VAR tag at /*IN_MEMORY +*/ : line 1. at E:/dev/HTML-Template/HTML-Template -2.5/blib/lib/HTML/Template.pm line 1862.

Win32::ReadDirectoryChangesW
"There are some stunningly novel ideas in Perl" -- Paul Graham
Y.A.N.F: Private Message XML Ticker
e
Re^2: OO concepts and relational databases
Y.A.N.F: Private Message XML Ticker (Changes Applied)
Make java code faster
tye's scratchpad
Re: I need a comparison/hashing algorithm (not the usual).
Adding sessions on-the-fly to POE program
Typoglycemia Fun
Universally unimportant and overused
Are we a dying breed?
Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others wandering the Monastery: (4)
As of 2024-03-28 16:59 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found