=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?
|