Petal-Utils-0.06/ 0000755 0001750 0001750 00000000000 10111374072 014714 5 ustar william william 0000000 0000000 Petal-Utils-0.06/t/ 0000755 0001750 0001750 00000000000 10111374072 015157 5 ustar william william 0000000 0000000 Petal-Utils-0.06/t/data/ 0000755 0001750 0001750 00000000000 10111374072 016070 5 ustar william william 0000000 0000000 Petal-Utils-0.06/t/data/22__limitr.html 0000444 0001750 0001750 00000000547 10107462626 020734 0 ustar william william 0000000 0000000
nolimit: limit1
limitr1: limit1
limitr2: limit2
Petal-Utils-0.06/t/data/23__create_href.html 0000444 0001750 0001750 00000000600 10107502007 021656 0 ustar william william 0000000 0000000
create_href1: Link
create_href2: Link
create_href3: FTP Link
create_href4: FTP Link
Petal-Utils-0.06/t/data/date.html 0000444 0001750 0001750 00000000656 10053116364 017703 0 ustar william william 0000000 0000000
date = date
date1 = 2003-09-05
date2 = 2003/09/05
date3 = 20030905
date4 = 20030905
Petal-Utils-0.06/t/data/logic.html 0000444 0001750 0001750 00000001454 10053116364 020060 0 ustar william william 0000000 0000000
first = first
second = second
first_name = first_name
first or second = or
first and second = and
first eq second = equal
first_name like regex = like
if first then first else second = if
if second then first else second = if
Petal-Utils-0.06/t/data/21__limit.html 0000444 0001750 0001750 00000000542 10107462610 020535 0 ustar william william 0000000 0000000
nolimit: limit1
limit1: limit1
limit2: limit2
Petal-Utils-0.06/t/data/uri.html 0000444 0001750 0001750 00000000465 10053116364 017563 0 ustar william william 0000000 0000000
& ${uri_escape: $and}
' ' ${uri_escape: space}
, ${uri_escape: comma}
; ${uri_escape: scolon}
/ ${uri_escape: slash}
? ${uri_escape: qmark}
. ${uri_escape: dot}
Petal-Utils-0.06/t/data/26__printf.html 0000444 0001750 0001750 00000001332 10110430424 020714 0 ustar william william 0000000 0000000
printf1:
name of dog
printf2:
# of children
printf3:
bank acct
printf4:
bank acct
printf5:
bank acct
printf6:
love
Petal-Utils-0.06/t/data/debug.html 0000444 0001750 0001750 00000000234 10053116364 020044 0 ustar william william 0000000 0000000
dump: dump
Petal-Utils-0.06/t/data/25__decode.html 0000444 0001750 0001750 00000003776 10110026457 020661 0 ustar william william 0000000 0000000
decode1: this appears to do nothing; should we catch it and throw an error?
decode2: false
decode2a: false
decode2b: false
decode3: true
decode4: return false
decode5: false
decode6: true
decode7: false
decode8: true
decode9: true
decode10: true
decode11: true
decode12: false
decode13: true
decode14: true
decode15: true
Petal-Utils-0.06/t/data/list.html 0000444 0001750 0001750 00000000271 10053116364 017732 0 ustar william william 0000000 0000000
sort: $key,
Petal-Utils-0.06/t/data/text.html 0000444 0001750 0001750 00000000455 10053116364 017747 0 ustar william william 0000000 0000000
lc: lc
uc: uc
uc_first: uc_first
Petal-Utils-0.06/t/data/24__substr.html 0000444 0001750 0001750 00000000716 10107507416 020753 0 ustar william william 0000000 0000000
substr1: string
substr2: string
substr3: string
substr4: string with ellipsis
substr5: string with ellipsis
Petal-Utils-0.06/t/08__uri.t 0000444 0001750 0001750 00000001356 10053116345 016616 0 ustar william william 0000000 0000000 #!/usr/bin/perl
##
## Tests for Petal::Utils :uri modifiers
##
use blib;
use strict;
#use warnings;
use Test::More qw( no_plan );
use Carp;
use t::LoadPetal;
use Petal::Utils qw( :uri );
my $hash = {
and => 'this&that',
space => 'this that',
comma => 'this,that',
scolon => 'this;that',
slash => 'this/that',
qmark => 'this?that',
dot => 'this.that',
};
my $template = Petal->new('uri.html');
my $out = $template->process( $hash );
# UriEscape
like($out, qr/this\%26that/, '&');
like($out, qr/this\%20that/, "' '");
like($out, qr/this\%2Cthat/, ',');
like($out, qr/this\%3Bthat/, ';');
like($out, qr/this\%2Fthat/, '/');
like($out, qr/this\%3Fthat/, '?');
like($out, qr/this\.that/, '.');
# that's enough proof for me.
Petal-Utils-0.06/t/01__import.t 0000444 0001750 0001750 00000001311 10053117473 017314 0 ustar william william 0000000 0000000 #!/usr/bin/perl
##
## Tests for Petal::Utils->import
##
use blib;
use strict;
#use warnings;
use Test::More qw(no_plan);
use Carp;
# use_ok() doesn't let us avoid calling import() so:
eval 'use Petal::Utils qw();';
is( $@, '', 'use Petal::Utils' );
eval 'use Petal::Utils qw( :none );';
is( $@, '', 'use set :none' );
eval 'use Petal::Utils qw( :default );';
is( $@, '', 'use set :default' );
eval 'use Petal::Utils qw( UpperCase );';
is( $@, '', 'use plugin UpperCase' );
{
no warnings;
eval 'use Petal::Utils qw( :non_existent );';
isnt( $@, '', 'error loading non-existent set' );
eval 'use Petal::Utils qw( non_existent );';
isnt( $@, '', 'error loading non-existent plugin' );
}
Petal-Utils-0.06/t/25__Decode.t 0000444 0001750 0001750 00000002207 10110026416 017166 0 ustar william william 0000000 0000000 #!/usr/bin/perl
##
## Tests for Petal::Utils::Decode module
##
use blib;
use strict;
use Test::More qw(no_plan);
use Carp;
use t::LoadPetal;
use Petal::Utils qw( :logic :text );
my $str = "Flipper";
my $str2 = "Dipper";
my $template = Petal->new('25__decode.html');
my $out = $template->process( {
str => $str,
str2 => $str2,
} );
like($out, qr/decode1:\s*\n/, 'decode1');
like($out, qr/decode2:\s*\n/, 'decode2');
like($out, qr/decode2a: Flipper\n/, 'decode2a');
like($out, qr/decode2b: Flip\n/, 'decode2b');
like($out, qr/decode3: true\n/, 'decode3 - true (1)');
like($out, qr/decode4:\s*\n/, 'decode4 - false (0)');
like($out, qr/decode5:\ false_string\n/, 'decode5 - false (false)');
like($out, qr/decode6: Metal\n/, 'decode6');
like($out, qr/decode7:\s*\n/, 'decode7');
like($out, qr/decode8: true\n/, 'decode8');
like($out, qr/decode9: true\n/, 'decode9');
like($out, qr/decode10: 100\n/, 'decode10');
like($out, qr/decode11: 250\n/, 'decode11');
like($out, qr/decode12:\s\n/, 'decode12');
like($out, qr/decode13: true\n/, 'decode13');
like($out, qr/decode14: 1.\n/, 'decode14');
like($out, qr/decode15: .1\n/, 'decode15');
Petal-Utils-0.06/t/LoadPetal.pm 0000444 0001750 0001750 00000000567 10053116345 017372 0 ustar william william 0000000 0000000 # Common code for loading Petal with default dir
# load things into the caller's package
use Petal;
use File::Spec;
my $base_dir = File::Spec->catdir(qw( t data ));
# Petal's global settings
$Petal::DISK_CACHE = 0;
$Petal::MEMORY_CACHE = 0;
$Petal::TAINT = 1;
$Petal::BASE_DIR = $base_dir;
$Petal::INPUT = "XHTML";
$Petal::OUTPUT = "XHTML";
1;
Petal-Utils-0.06/t/26__Printf.t 0000444 0001750 0001750 00000001415 10110426737 017260 0 ustar william william 0000000 0000000 #!/usr/bin/perl
##
## Tests for Petal::Utils::Printf module
##
use blib;
use strict;
use Test::More qw(no_plan);
use Carp;
use Data::Dumper;
use t::LoadPetal;
use Petal::Utils qw( :logic :text );
my $children = [ qw(Elroy Judi) ];
my $template = Petal->new('26__printf.html');
my $out = $template->process( {
dad => 'George',
mom => 'Jane',
dog => 'Astro',
children => $children,
children_count => scalar @$children,
bank_balance => '201.5',
} );
like($out, qr/printf1: Astro\n/, 'printf1');
like($out, qr/printf2: 02\n/, 'printf2');
like($out, qr/printf3: 201.50\n/, 'printf3');
like($out, qr/printf4: \$201.50\n/, 'printf4');
like($out, qr/printf5: Balance = \$201.50\n/, 'printf5');
like($out, qr/printf6: George and Jane\n/, 'printf6');
Petal-Utils-0.06/t/05__date.t 0000444 0001750 0001750 00000001276 10053116345 016732 0 ustar william william 0000000 0000000 #!/usr/bin/perl
##
## Tests for Petal::Utils :date modifiers
##
use blib;
use strict;
#use warnings;
use Test::More qw( no_plan );
use Carp;
use t::LoadPetal;
use Petal::Utils qw( :date );
my $hash = {
date => 1,
date1 => '2003-09-05',
date2 => '2003/09/05',
date3 => '20030905',
};
my $template = Petal->new('date.html');
my $out = $template->process( $hash );
# Dates:
like($out, qr|date = \w+\s+\d+ \d+ (?:\d+\:?)+|, 'date');
like($out, qr|date1 = 09/05/2003|, 'us_date');
like($out, qr|date2 = 09/05/2003|, 'us_date');
like($out, qr|date3 = 09/05/2003|, 'us_date');
TODO: {
local $TODO = 'dynamically set date separator';
like($out, qr|date4 = 09-05-2003|, 'us_date');
}
Petal-Utils-0.06/t/06__list.t 0000444 0001750 0001750 00000000561 10053116345 016765 0 ustar william william 0000000 0000000 #!/usr/bin/perl
##
## Tests for Petal::Utils :list modifiers
##
use blib;
use strict;
#use warnings;
use Test::More qw( no_plan );
use Carp;
use t::LoadPetal;
use Petal::Utils qw( :list );
my $hash = {
array_ref => [ 1..3 ],
};
my $template = Petal->new('list.html');
my $out = $template->process( $hash );
# Sort
like($out, qr/sort:.+?1.+2.+3/, 'sort');
Petal-Utils-0.06/t/23__Create_Href.t 0000444 0001750 0001750 00000001277 10107502447 020167 0 ustar william william 0000000 0000000 #!/usr/bin/perl
##
## Tests for Petal::Utils::CreateHref module
##
use blib;
use strict;
use Test::More qw(no_plan);
use Carp;
use t::LoadPetal;
use Petal::Utils qw( :uri );
my $url1 = 'http://www.foo.com';
my $url2 = 'www.foo.com';
my $url3 = 'ftp://ftp.foo.com';
my $url4 = 'ftp.foo.com';
my $template = Petal->new('23__create_href.html');
my $out = $template->process( {
url1 => $url1,
url2 => $url2,
url3 => $url3,
url4 => $url4,
} );
like($out, qr!create_href1: new('21__limit.html');
my $out = $template->process( {
items => [ 'item1', 'item2', 'item3' ],
} );
like($out, qr/nolimit: item1item2item3/, 'no limit');
like($out, qr/limit1: item1/, 'limit 1');
like($out, qr/limit2: item1item2/, 'limit 2');
Petal-Utils-0.06/t/24__Substr.t 0000444 0001750 0001750 00000001103 10107507377 017276 0 ustar william william 0000000 0000000 #!/usr/bin/perl
##
## Tests for Petal::Utils::Substr module
##
use blib;
use strict;
use Test::More qw(no_plan);
use Carp;
use t::LoadPetal;
use Petal::Utils qw( :text );
my $str = "A very merry unbirthday to you.";
my $template = Petal->new('24__substr.html');
my $out = $template->process( {
str => $str,
} );
like($out, qr/substr1: $str/, 'substr1');
like($out, qr/substr2: very merry unbirthday to you./, 'substr2');
like($out, qr/substr3: very/, 'substr3');
like($out, qr/substr4: very\.\.\./, 'substr4');
like($out, qr/substr5: Very\.\.\./, 'substr4');
Petal-Utils-0.06/t/22__Limitr.t 0000444 0001750 0001750 00000000714 10107502507 017247 0 ustar william william 0000000 0000000 #!/usr/bin/perl
##
## Tests for Petal::Utils::Limitr module
##
use blib;
use strict;
use Test::More qw(no_plan);
use Carp;
use t::LoadPetal;
use Petal::Utils qw( :list );
my $template = Petal->new('22__limitr.html');
my $out = $template->process( {
items => [ 'item1', 'item2', 'item3' ],
} );
like($out, qr/nolimit: item1item2item3/, 'no limit');
like($out, qr/limitr1: item\d/, 'limit 1');
like($out, qr/limitr2: item\ditem\d/, 'limit 2');
Petal-Utils-0.06/t/04__logic.t 0000444 0001750 0001750 00000001474 10053116345 017111 0 ustar william william 0000000 0000000 #!/usr/bin/perl
##
## Tests for Petal::Utils :logic modifiers
##
use blib;
use strict;
#use warnings;
use Test::More qw( no_plan );
use Carp;
use t::LoadPetal;
use Petal::Utils qw( :logic );
my $hash = {
first => 0,
second => 1,
first_name => "William",
last_name => "McKee",
email => 'william@knowmad.com',
};
my $template = Petal->new('logic.html');
my $out = $template->process( $hash );
like($out, qr/first = 0/, 'first');
like($out, qr/second = 1/, 'second');
# Comparisons
like($out, qr/first or second = 1/, 'or');
like($out, qr/first and second = 0/, 'and');
like($out, qr/first eq second = 0/, 'equal');
like($out, qr/first_name like regex = 1/, 'like');
# If/then/else
like($out, qr/first then first else second = 1/, 'if');
like($out, qr/second then first else second = 0/, 'if');
Petal-Utils-0.06/t/20__Base.t 0000444 0001750 0001750 00000006262 10110441617 016661 0 ustar william william 0000000 0000000 #!/usr/bin/perl
##
## Tests for Petal::Utils::Base module
##
use blib;
use strict;
use Test::More qw(no_plan);
use Carp;
use Data::Dumper;
use t::LoadPetal;
use base qw( Petal::Utils::Base );
##
## split_first_arg
##
#
# Define argument strings for testing
my $arg_string1 = 'first second';
my $arg_string2 = q~'first' second~;
my $arg_string3 = q~first second third~;
my $arg_string4 = q~'first' second third fourth~;
my $arg_string5 = q~string: first second~; # arg list with embedded modifier
#
# Perform tests
my @args = Petal::Utils::Base->split_first_arg($arg_string1);
is( $args[0], 'first', "split_first_arg - '$arg_string1'" );
is( $args[1], 'second', "split_first_arg - '$arg_string1'" );
@args = Petal::Utils::Base->split_first_arg($arg_string2);
is( $args[0], q~'first'~, "split_first_arg - '$arg_string2'" );
is( $args[1], 'second', "split_first_arg - '$arg_string2'" );
@args = Petal::Utils::Base->split_first_arg($arg_string3);
is( $args[0], 'first', "split_first_arg - '$arg_string3'" );
is( $args[1], 'second third', "split_first_arg - '$arg_string3'" );
is( $args[2], undef, "split_first_arg - '$arg_string3'" );
@args = Petal::Utils::Base->split_first_arg($arg_string4);
is( $args[0], q~'first'~, "split_first_arg - '$arg_string4'" );
is( $args[1], 'second third fourth', "split_first_arg - '$arg_string4'" );
is( $args[2], undef, "split_first_arg - '$arg_string4'" );
is( $args[3], undef, "split_first_arg - '$arg_string4'" );
@args = Petal::Utils::Base->split_first_arg($arg_string5);
is( $args[0], 'string:', "split_first_arg - '$arg_string5''" );
is( $args[1], 'first second', "split_first_arg - '$arg_string5''" );
##
## split_args
##
#
# Perform tests
@args = Petal::Utils::Base->split_args($arg_string1);
is( $args[0], 'first', "split_args - '$arg_string1'" );
is( $args[1], 'second', "split_args - '$arg_string1'" );
@args = Petal::Utils::Base->split_args($arg_string2);
is( $args[0], q~'first'~, "split_args - '$arg_string2'" );
is( $args[1], 'second', "split_args - '$arg_string2'" );
@args = Petal::Utils::Base->split_args($arg_string3);
is( $args[0], 'first', "split_args - '$arg_string3'" );
is( $args[1], 'second', "split_args - '$arg_string3'" );
is( $args[2], 'third', "split_args - '$arg_string3'" );
@args = Petal::Utils::Base->split_args($arg_string4);
is( $args[0], q~'first'~, "split_args - '$arg_string4'" );
is( $args[1], 'second', "split_args - '$arg_string4'" );
is( $args[2], 'third', "split_args - '$arg_string4'" );
is( $args[3], 'fourth', "split_args - '$arg_string4'" );
@args = Petal::Utils::Base->split_args($arg_string5);
is( $args[0], 'string:', "split_args - '$arg_string5'" );
is( $args[1], 'first', "split_args - '$arg_string5'" );
is( $args[2], 'second', "split_args - '$arg_string5'" );
##
## fetch_arg
##
my $data_hash = {
dad => 'George',
mom => 'Jane',
dog => 'Astro',
};
my $hash = Petal::Hash->new(%$data_hash);
is ( Petal::Utils::Base->fetch_arg($hash, 'dad'), $data_hash->{'dad'}, "Fetch value of Dad" );
is ( Petal::Utils::Base->fetch_arg($hash, "'plain'"), 'plain', "Fetch plaintext" );
is ( Petal::Utils::Base->fetch_arg($hash, '123'), '123', "Fetch number" );
is ( Petal::Utils::Base->fetch_arg($hash, '123.50'), '123.50', "Fetch number with decimal" );
Petal-Utils-0.06/t/07__hash.t 0000444 0001750 0001750 00000001560 10053116345 016736 0 ustar william william 0000000 0000000 #!/usr/bin/perl
##
## Tests for Petal::Utils :hash modifiers
##
use blib;
use strict;
#use warnings;
use Test::More qw( no_plan );
use Carp;
use t::LoadPetal;
use Petal::Utils qw( :hash );
my $hash = {
keys_hash_ref => {
kkey1 => 'kvalue1',
kkey2 => 'kvalue2',
kkey3 => 'kvalue3',
},
each_hash_ref => {
ekey1 => 'evalue1',
ekey2 => 'evalue2',
ekey3 => 'evalue3',
},
};
my $template = Petal->new('hash.html');
my $out = $template->process( $hash );
# Each
like($out, qr/ekey1 => evalue1/, 'each');
like($out, qr/ekey2 => evalue2/, 'each');
like($out, qr/ekey3 => evalue3/, 'each');
# Keys
like($out, qr/kkey1 =>/, 'keys');
like($out, qr/kkey2 =>/, 'keys');
like($out, qr/kkey3 =>/, 'keys');
# use keys to lookup values
TODO: {
local $TODO = 'Petal cannot use dynamic hash keys to look up values';
like($out, qr/kkey1 => kvalue1/, 'dkeys');
}
Petal-Utils-0.06/t/03__text.t 0000444 0001750 0001750 00000000623 10053116345 016772 0 ustar william william 0000000 0000000 #!/usr/bin/perl
##
## Tests for Petal::Utils :text modifiers
##
use blib;
use strict;
#use warnings;
use Test::More qw( no_plan );
use Carp;
use t::LoadPetal;
use Petal::Utils qw( :text );
my $template = Petal->new('text.html');
my $out = $template->process( {} );
like($out, qr/lc: all_caps/, 'lc');
like($out, qr/uc: ALL_LOWER/, 'uc');
like($out, qr/uc_first: William mckee/, 'uc_first');
Petal-Utils-0.06/t/02__debug.t 0000444 0001750 0001750 00000000611 10053116345 017070 0 ustar william william 0000000 0000000 #!/usr/bin/perl
##
## Tests for Petal::Utils :debug modifiers
##
use blib;
use strict;
#use warnings;
use Test::More qw( no_plan );
use Carp;
use t::LoadPetal;
use Petal::Utils qw( :debug );
my $hash = {
debug => { name => 'test', array => [ 1..3 ] },
};
my $template = Petal->new('debug.html');
my $out = $template->process( $hash );
# Dump
like($out, qr/dump: \$VAR1/, 'dump');
Petal-Utils-0.06/lib/ 0000755 0001750 0001750 00000000000 10111374072 015462 5 ustar william william 0000000 0000000 Petal-Utils-0.06/lib/Petal/ 0000755 0001750 0001750 00000000000 10111374072 016527 5 ustar william william 0000000 0000000 Petal-Utils-0.06/lib/Petal/Utils/ 0000755 0001750 0001750 00000000000 10111374072 017627 5 ustar william william 0000000 0000000 Petal-Utils-0.06/lib/Petal/Utils/Printf.pm 0000444 0001750 0001750 00000002212 10111373742 021425 0 ustar william william 0000000 0000000 package Petal::Utils::Printf;
use strict;
use warnings::register;
use Carp;
use base qw( Petal::Utils::Base );
use constant name => 'printf';
use constant aliases => qw();
our $VERSION = ((require Petal::Utils), $Petal::Utils::VERSION)[1];
our $REVISION = (split(/ /, ' $Revision: 1.3 $ '))[2];
sub process {
my $class = shift;
my $hash = shift;
my $args = shift || confess( "'printf' expects at least 2 arguments (got nothing)!" );
my @tokens = $class->split_args( $args );
my $format = shift @tokens;
$format =~ s/\'//g;
my @printf_args = ();
foreach my $arg (@tokens) {
push @printf_args, $class->fetch_arg($hash, $arg);
}
return sprintf($format, @printf_args);
}
1;
__END__
Description: The printf modifier acts exactly like Perl's sprintf function to
print formatted strings.
Basic Usage:
printf: format list
format is the string you wish to be interpolated by printf
list is a list of values to insert
Example:
Astro
# true
02
# false
See also:
Test template t/data/26__printf.html for more examples of use.
Petal-Utils-0.06/lib/Petal/Utils/Decode.pm 0000444 0001750 0001750 00000003342 10111373742 021353 0 ustar william william 0000000 0000000 package Petal::Utils::Decode;
use strict;
use warnings::register;
use Carp;
use base qw( Petal::Utils::Base );
use constant name => 'decode';
use constant aliases => qw();
our $VERSION = ((require Petal::Utils), $Petal::Utils::VERSION)[1];
our $REVISION = (split(/ /, ' $Revision: 1.3 $ '))[2];
sub process {
my $class = shift;
my $hash = shift;
my $args = shift || confess( "'decode' expects at least 1 variable (got nothing)!" );
my @tokens = $class->split_args( $args );
my $tvar = $class->fetch_arg($hash, shift @tokens);
use Data::Dumper;
while(@tokens) {
my $a = $class->fetch_arg($hash, shift @tokens);
my $b = $class->fetch_arg($hash, shift @tokens);
return $a unless defined($b);
return $b if ($tvar =~ /$a/);
}
}
1;
__END__
Description: The decode function has the functionality of an IF-THEN-ELSE
statement. A case-sensitive regex comparison is performed.
Basic Usage:
decode: expression search result [search result]... [default]
expression is the value to compare.
search is the value that is compared against expression.
result is the value returned, if expression is equal to search.
default is optional. If no matches are found, the decode will return
default. If default is omitted, then the decode statement will return
null (if no matches are found).
All text strings must be enclosed in single quotes.
Example:
If $str = dog,
string
# true
string
# false
string
# false
See also:
http://www.techonthenet.com/oracle/functions/decode.htm
Test template t/data/25__decode.html for more examples of use.
Petal-Utils-0.06/lib/Petal/Utils/Like.pm 0000444 0001750 0001750 00000001407 07730354072 021064 0 ustar william william 0000000 0000000 package Petal::Utils::Like;
use strict;
use warnings::register;
use Carp;
use base qw( Petal::Utils::Base );
use constant name => 'like';
use constant aliases => qw();
our $VERSION = ((require Petal::Utils), $Petal::Utils::VERSION)[1];
our $REVISION = (split(/ /, ' $Revision: 1.3 $ '))[2];
sub process {
my $class = shift;
my $hash = shift;
my $args = shift || confess( "'like' expects a variable and a regex (got nothing)!" );
my @args = $class->split_first_arg( $args );
$args = $args[0] || confess( "1st arg to 'like' should be a variable (got nothing)!" );
my $re = $args[1] || confess( "2nd arg to 'like' should be a regex (got nothing)!" );
my $result = $hash->fetch( $args );
return $result =~ /$re/ ? 1 : 0;
}
1;
Petal-Utils-0.06/lib/Petal/Utils/Limit.pm 0000444 0001750 0001750 00000002331 10111373742 021243 0 ustar william william 0000000 0000000 package Petal::Utils::Limit;
use strict;
use warnings::register;
use Carp;
use base qw( Petal::Utils::Base );
use constant name => 'limit';
use constant aliases => qw();
our $VERSION = ((require Petal::Utils), $Petal::Utils::VERSION)[1];
our $REVISION = (split(/ /, ' $Revision: 1.2 $ '))[2];
sub process {
my $class = shift;
my $hash = shift;
my $args = shift || confess( "'limit' expects 2 variables (got nothing)!" );
my @args = $class->split_args( $args );
my $key = $args[0] || confess( "1st arg to 'limit' should be an array (got nothing)!" );
my $count = $args[1] || confess( "2nd arg to 'limit' should be a variable (got nothing)!" );
my $arrayref = $hash->fetch($key);
$count--;
# trim $count to max size of array
$count = $#$arrayref if $#$arrayref < $count;
return [] if $count < 0;
return [@{$arrayref}[0 .. $count]];
}
1;
__END__
Description: Limit elements returned from an array
Basic Usage:
limit:
list - a list
count - an integer value, if greater than the total items in the list,
return complete list
Example:
Petal-Utils-0.06/lib/Petal/Utils/Substr.pm 0000444 0001750 0001750 00000003141 10111373742 021447 0 ustar william william 0000000 0000000 package Petal::Utils::Substr;
use strict;
use warnings::register;
use Carp;
use base qw( Petal::Utils::Base );
use constant name => 'substr';
use constant aliases => qw();
our $VERSION = ((require Petal::Utils), $Petal::Utils::VERSION)[1];
our $REVISION = (split(/ /, ' $Revision: 1.2 $ '))[2];
sub process {
my $class = shift;
my $hash = shift;
my $args = shift || confess( "'create_href' expects 1 or 2 variables (got nothing)!" );
my @args = $class->split_args( $args );
my $text_key = $args[0] || confess( "1st arg to 'limit' should be a variable (got nothing)!" );
my $text = $hash->fetch($text_key);
my $start = $args[1] || 0;
my $len = $args[2] || length($text);
my $ellipsis = $args[3] || 0;
my $new_text = substr($text, $start, $len);
if ( $ellipsis && (length($new_text) >= ($len - $start)) ) {
$new_text .= "...";
}
return $new_text;
}
1;
__END__
Description: Extract a substring.
Basic Usage:
substr:
string - a string
offset - offset from beginning of string (optional)
length - length of string (optional)
ellipsis - set to true to add an ellipsis (...) if original string is
truncated (optional)
Example:
string # does nothing
string # cuts the first two chars
string # extracts chars 2-7
string with ellipsis # same as above and adds an ellipsis
See also:
`perldoc -f substr`
Petal-Utils-0.06/lib/Petal/Utils/Sort.pm 0000444 0001750 0001750 00000001216 07730354072 021125 0 ustar william william 0000000 0000000 package Petal::Utils::Sort;
use strict;
use warnings::register;
use Carp;
use base qw( Petal::Utils::Base );
use constant name => 'sort';
use constant aliases => qw();
our $VERSION = ((require Petal::Utils), $Petal::Utils::VERSION)[1];
our $REVISION = (split(/ /, ' $Revision: 1.3 $ '))[2];
sub process {
my $class = shift;
my $hash = shift;
my $args = shift || confess( "'sort' expects an array ref (got nothing)!" );
my $result = $hash->fetch( $args );
confess( "1st arg to 'sort' is not an array ($args = $result)!" )
unless ref($result) eq 'ARRAY'; # ignore object for now
return [ sort @$result ];
}
1;
Petal-Utils-0.06/lib/Petal/Utils/UC_First.pm 0000444 0001750 0001750 00000001076 07730354072 021660 0 ustar william william 0000000 0000000 package Petal::Utils::UC_First;
use strict;
use warnings::register;
use Carp;
use base qw( Petal::Utils::Base );
use constant name => 'uc_first';
use constant aliases => qw();
our $VERSION = ((require Petal::Utils), $Petal::Utils::VERSION)[1];
our $REVISION = (split(/ /, ' $Revision: 1.2 $ '))[2];
sub process {
my $class = shift;
my $hash = shift;
my $args = shift || confess( "'uc_first' expects a variable (got nothing)!" );
my $result = $hash->fetch($args);
return "\u$result";
}
1;
__END__
# Uppercase the first letter of the string
Petal-Utils-0.06/lib/Petal/Utils/Dump.pm 0000444 0001750 0001750 00000001026 07730354072 021102 0 ustar william william 0000000 0000000 package Petal::Utils::Dump;
use strict;
use warnings::register;
use Carp;
use Data::Dumper;
use base qw( Petal::Utils::Base );
use constant name => 'dump';
use constant aliases => qw();
our $VERSION = ((require Petal::Utils), $Petal::Utils::VERSION)[1];
our $REVISION = (split(/ /, ' $Revision: 1.3 $ '))[2];
sub process {
my $class = shift;
my $hash = shift;
my $args = shift || confess( "'dump' expects a variable (got nothing)" );
my $result = $hash->fetch( $args );
return Dumper( $result );
}
1;
Petal-Utils-0.06/lib/Petal/Utils/Or.pm 0000444 0001750 0001750 00000001462 07730354072 020561 0 ustar william william 0000000 0000000 package Petal::Utils::Or;
use strict;
use warnings::register;
use Carp;
use base qw( Petal::Utils::Base );
use constant name => 'or';
use constant aliases => qw();
our $VERSION = ((require Petal::Utils), $Petal::Utils::VERSION)[1];
our $REVISION = (split(/ /, ' $Revision: 1.2 $ '))[2];
sub process {
my $class = shift;
my $hash = shift;
my $args = shift || confess( "'or' expects 2 variables (got nothing)!" );
my @args = $class->split_first_arg( $args );
my $arg1 = $args[0] || confess( "1st arg to 'or' should be a variable (got nothing)!" );
my $arg2 = $args[1] || confess( "2nd arg to 'or' should be a variable (got nothing)!" );
my $h1 = $hash->fetch($arg1);
my $h2 = $hash->fetch($arg2);
return ($h1 || $h2) ? 1 : 0;
}
1;
__END__
# Perform an OR comparison
Petal-Utils-0.06/lib/Petal/Utils/Base.pm 0000444 0001750 0001750 00000003227 10111373524 021042 0 ustar william william 0000000 0000000 package Petal::Utils::Base;
#rename: package Petal::Plugin; ?
use strict;
use warnings::register;
use Carp;
our $VERSION = ((require Petal::Utils), $Petal::Utils::VERSION)[1];
our $REVISION = (split(/ /, ' $Revision: 1.5 $ '))[2];
## Define the enclosed packages inside the Petal Modifiers hash
sub install {
my $class = shift;
foreach my $name ($class->name, $class->aliases) {
$Petal::Hash::MODIFIERS->{"$name:"} = $class;
}
return $class;
}
sub process {
my $class = shift;
confess( "$class does not override process()" );
}
sub name {
my $class = shift;
confess( "$class does not override name()" );
}
sub aliases {
my $class = shift;
confess( "$class does not override aliases()" );
}
sub split_first_arg {
my $class = shift;
my $args = shift;
# don't use split(/\s/,...) as we might kill an expression that way
return ($args =~ /\A(.+?)\s+(.*)\z/);
}
# Return a list of all arguments as an array - does not perform expansion on
# embedded modifiers
sub split_args {
my $class = shift;
my ($args) = @_;
# W. Smith's regex
return ($args =~ /('[^']+'|\S+)/g);
}
# Returns an argument from the data hash as a string/object or as a plaintext
# if arg is surrounded by single quotes or a number (decimal points OK)
# Arguments:
# $hash - reference to the Petal data hash
# $arg - the argument
sub fetch_arg {
my $class = shift;
my ($hash, $arg) = @_;
return undef unless defined($arg);
if($arg =~ /\'/) {
$arg =~ s/\'//g;
return $arg;
}
elsif($arg =~ /^[0-9.]+$/) {
return $arg;
}
else {
#warn "Returning hash key for $arg";
return $hash->fetch($arg);
}
}
1;
Petal-Utils-0.06/lib/Petal/Utils/Equal.pm 0000444 0001750 0001750 00000001550 07730354072 021246 0 ustar william william 0000000 0000000 package Petal::Utils::Equal;
use strict;
use warnings::register;
use Carp;
use base qw( Petal::Utils::Base );
use constant name => 'equal';
use constant aliases => qw( eq );
our $VERSION = ((require Petal::Utils), $Petal::Utils::VERSION)[1];
our $REVISION = (split(/ /, ' $Revision: 1.3 $ '))[2];
sub process {
my $class = shift;
my $hash = shift;
my $args = shift || confess( "'equal' expects 2 variables (got nothing)!" );
my @args = $class->split_first_arg( $args );
my $arg1 = $args[0] || confess( "1st arg to 'equal' should be a variable (got nothing)!" );
my $arg2 = $args[1] || confess( "2nd arg to 'equal' should be a variable (got nothing)!" );
my $h1 = $hash->fetch($arg1);
my $h2 = $hash->fetch($arg2);
return $h1 == $h2 ? 1 : 0 if ($h1 =~ /\A\d+\z/ and $h2 =~ /\A\d+\z/);
return $h1 eq $h2 ? 1 : 0;
}
1;
Petal-Utils-0.06/lib/Petal/Utils/Each.pm 0000444 0001750 0001750 00000001330 07730354072 021033 0 ustar william william 0000000 0000000 package Petal::Utils::Each;
use strict;
use warnings::register;
use Carp;
use base qw( Petal::Utils::Base );
use constant name => 'each';
use constant aliases => qw();
our $VERSION = ((require Petal::Utils), $Petal::Utils::VERSION)[1];
our $REVISION = (split(/ /, ' $Revision: 1.2 $ '))[2];
sub process {
my $class = shift;
my $hash = shift;
my $args = shift || confess( "'each' expects a hash ref (got nothing)" );
my $result = $hash->fetch( $args );
confess( "1st arg to 'each' is not a hash ($args = $result)!" )
unless ref($result) eq 'HASH';
return [ map { { key => $_, val => $result->{$_} } } keys %$result ];
}
1;
__END__
# Return a list of key/value pairs for a hashref
Petal-Utils-0.06/lib/Petal/Utils/Limitr.pm 0000444 0001750 0001750 00000003135 10111373742 021430 0 ustar william william 0000000 0000000 package Petal::Utils::Limitr;
use strict;
use warnings::register;
use Carp;
use base qw( Petal::Utils::Base );
use constant name => 'limitr';
use constant aliases => qw();
our $VERSION = ((require Petal::Utils), $Petal::Utils::VERSION)[1];
our $REVISION = (split(/ /, ' $Revision: 1.2 $ '))[2];
sub process {
my $class = shift;
my $hash = shift;
my $args = shift || confess( "'limitr' expects 2 variables (got nothing)!" );
my @args = $class->split_args( $args );
my $key = $args[0] || confess( "1st arg to 'limit' should be an array (got nothing)!" );
my $count = $args[1] || confess( "2nd arg to 'limit' should be a variable (got nothing)!" );
my $arrayref = $hash->fetch($key);
# Shuffle full array
fisher_yates_shuffle($arrayref);
$count--;
# trim $count to max size of array
$count = $#$arrayref if $#$arrayref < $count;
return [] if $count < 0;
return [@{$arrayref}[0 .. $count]];
}
# Generate a random permutation of @array in place
# Usage: fisher_yates_shuffle( \@array ) :
sub fisher_yates_shuffle {
my $array = shift;
return unless $#$array >= 0;
my $i;
for ($i = @$array; --$i; ) {
my $j = int rand ($i+1);
next if $i == $j;
@$array[$i,$j] = @$array[$j,$i];
}
}
1;
__END__
Description: Limit elements returned from a randomized array
Basic Usage:
limitr:
list - a list
count - an integer value, if greater than the total items in the list,
return complete list
Example:
Petal-Utils-0.06/lib/Petal/Utils/LowerCase.pm 0000444 0001750 0001750 00000001020 07730354072 022053 0 ustar william william 0000000 0000000 package Petal::Utils::LowerCase;
use strict;
use warnings::register;
use Carp;
use base qw( Petal::Utils::Base );
use constant name => 'lowercase';
use constant aliases => qw( lc );
our $VERSION = ((require Petal::Utils), $Petal::Utils::VERSION)[1];
our $REVISION = (split(/ /, ' $Revision: 1.2 $ '))[2];
sub process {
my $class = shift;
my $hash = shift;
my $args = shift || confess( "'lowercase' expects a variable (got nothing)!" );
my $result = $hash->fetch($args);
return lc($result);
}
1;
Petal-Utils-0.06/lib/Petal/Utils/UpperCase.pm 0000444 0001750 0001750 00000001021 07730354072 022057 0 ustar william william 0000000 0000000 package Petal::Utils::UpperCase;
use strict;
use warnings::register;
use Carp;
use base qw( Petal::Utils::Base );
use constant name => 'uppercase';
use constant aliases => qw( uc );
our $VERSION = ((require Petal::Utils), $Petal::Utils::VERSION)[1];
our $REVISION = (split(/ /, ' $Revision: 1.2 $ '))[2];
sub process {
my $class = shift;
my $hash = shift;
my $args = shift || confess( "'uppercase' expects a variable (got nothing)!" );
my $result = $hash->fetch($args);
return uc($result);
}
1;
Petal-Utils-0.06/lib/Petal/Utils/Date.pm 0000444 0001750 0001750 00000001160 07730354072 021051 0 ustar william william 0000000 0000000 package Petal::Utils::Date;
use strict;
use warnings::register;
use Carp;
use Date::Format;
use base qw( Petal::Utils::Base );
use constant name => 'date';
use constant aliases => qw();
our $VERSION = ((require Petal::Utils), $Petal::Utils::VERSION)[1];
our $REVISION = (split(/ /, ' $Revision: 1.2 $ '))[2];
sub process {
my $self = shift;
my $hash = shift;
my $args = shift || confess( "'date' expects a variable (got nothing)" );
my $result = $hash->fetch( $args );
return unless length($result); # do nothing if $args evaluates to nothing
return time2str('%b %e %Y %T', $result);
}
1;
Petal-Utils-0.06/lib/Petal/Utils/UriEscape.pm 0000444 0001750 0001750 00000001211 10053116344 022037 0 ustar william william 0000000 0000000 package Petal::Utils::UriEscape;
use strict;
use warnings::register;
use Carp;
use URI::Escape qw( &uri_escape );
use base qw( Petal::Utils::Base );
use constant name => 'uri_escape';
use constant aliases => qw();
our $VERSION = ((require Petal::Utils), $Petal::Utils::VERSION)[1];
our $REVISION = (split(/ /, ' $Revision: 1.1 $ '))[2];
sub process {
my $self = shift;
my $hash = shift;
my $args = shift || confess( "'uri_escape' expects a variable (got nothing)" );
my $result = $hash->fetch( $args );
return unless length( $result ); # do nothing if $args evaluates to nothing
return uri_escape( $result );
}
1;
Petal-Utils-0.06/lib/Petal/Utils/And.pm 0000444 0001750 0001750 00000001470 07730354072 020702 0 ustar william william 0000000 0000000 package Petal::Utils::And;
use strict;
use warnings::register;
use Carp;
use base qw( Petal::Utils::Base );
use constant name => 'and';
use constant aliases => qw();
our $VERSION = ((require Petal::Utils), $Petal::Utils::VERSION)[1];
our $REVISION = (split(/ /, ' $Revision: 1.2 $ '))[2];
sub process {
my $class = shift;
my $hash = shift;
my $args = shift || confess( "'and' expects 2 variables (got nothing)!" );
my @args = $class->split_first_arg( $args );
my $arg1 = $args[0] || confess( "1st arg to 'and' should be a variable (got nothing)!" );
my $arg2 = $args[1] || confess( "2nd arg to 'and' should be a variable (got nothing)!" );
my $h1 = $hash->fetch($arg1);
my $h2 = $hash->fetch($arg2);
return ($h1 && $h2) ? 1 : 0;
}
1;
__END__
# Perform an AND comparison
Petal-Utils-0.06/lib/Petal/Utils/US_Date.pm 0000444 0001750 0001750 00000001656 07730354072 021472 0 ustar william william 0000000 0000000 package Petal::Utils::US_Date;
use strict;
use warnings::register;
use Carp;
use base qw( Petal::Utils::Base );
use constant name => 'us_date';
use constant aliases => qw();
our $VERSION = ((require Petal::Utils), $Petal::Utils::VERSION)[1];
our $REVISION = (split(/ /, ' $Revision: 1.2 $ '))[2];
sub process {
my $class = shift;
my $hash = shift;
my $args = shift || confess( "'us_date' expects a variable (got nothing)!" );
my ($year,$mon,$day);
my ($date, $sep) = $hash->fetch($args);
$sep ||= '/';
if ($date =~ /[-|\/]/) {
($year,$mon,$day) = split(/[-|\/]/, $date);
}
else {
($year,$mon,$day) = $date =~ /(\d{4})(\d{2})(\d{2})/;
}
return sprintf("%02d$sep%02d$sep%04d", $mon,$day,$year);
}
1;
__END__
# Convert date from yyyy-mm-dd|yyyy/mm/dd|yyyymmdd to mm/dd/yyyy
# Arguments:
# $date - the date to be converted
# [$sep] - separator to use in new string (defaults to /)
Petal-Utils-0.06/lib/Petal/Utils/If.pm 0000444 0001750 0001750 00000001722 07730354072 020536 0 ustar william william 0000000 0000000 package Petal::Utils::If;
use strict;
use warnings::register;
use Carp;
use base qw( Petal::Utils::Base );
use constant name => 'if';
use constant aliases => qw();
our $VERSION = ((require Petal::Utils), $Petal::Utils::VERSION)[1];
our $REVISION = (split(/ /, ' $Revision: 1.2 $ '))[2];
sub process {
my $class = shift;
my $hash = shift;
my $args = shift || confess( "'if' expects args of the form 'if: ... then: ... [else: ...]' (got nothing)!" );
my @args = $args =~ /\A(.+?)\sthen:\s+(.+?)(?:\s+else:\s+(.+?))?\z/;
confess( "'if' expects arguments of the form: 'if: ... then: ... [else: ...]', not 'if: $args'!" ) unless @args;
$args[0] || confess( "1st arg to 'if' should be an expression (got nothing)!" );
$args[1] || confess( "2nd arg to 'if' (after then:) should be an expression (got nothing)!" );
return $hash->fetch($args[1]) if $hash->fetch($args[0]);
return $hash->fetch($args[2]) if $args[2];
return '';
}
1;
Petal-Utils-0.06/lib/Petal/Utils/Keys.pm 0000444 0001750 0001750 00000001272 07730354072 021113 0 ustar william william 0000000 0000000 package Petal::Utils::Keys;
use strict;
use warnings::register;
use Carp;
use base qw( Petal::Utils::Base );
use constant name => 'keys';
use constant aliases => qw();
our $VERSION = ((require Petal::Utils), $Petal::Utils::VERSION)[1];
our $REVISION = (split(/ /, ' $Revision: 1.2 $ '))[2];
sub process {
my $class = shift;
my $hash = shift;
my $args = shift || confess( "'keys' expects a hash ref (got nothing)!" );
my $result = $hash->fetch( $args );
confess( "1st arg to 'keys' is not a hash ($args = $result)!" )
unless ref($result) eq 'HASH'; # ignore object for now
return [ keys %$result ];
}
1;
__END__
# Return a list of keys for a hashref
Petal-Utils-0.06/lib/Petal/Utils/Create_Href.pm 0000444 0001750 0001750 00000002424 10111373742 022337 0 ustar william william 0000000 0000000 package Petal::Utils::Create_Href;
use strict;
use warnings::register;
use Carp;
use base qw( Petal::Utils::Base );
use constant name => 'create_href';
use constant aliases => qw();
our $VERSION = ((require Petal::Utils), $Petal::Utils::VERSION)[1];
our $REVISION = (split(/ /, ' $Revision: 1.2 $ '))[2];
sub process {
my $class = shift;
my $hash = shift;
my $args = shift || confess( "'create_href' expects 1 or 2 variables (got nothing)!" );
my @args = $class->split_args( $args );
my $key = $args[0] || confess( "1st arg to 'limit' should be a variable (got nothing)!" );
my $protocol = $args[1] || 'http';
my $href = $hash->fetch($key);
unless ($href =~ /^$protocol:/) {
$protocol = "$protocol://";
$protocol .= '/' if $protocol =~ /file/i;
$href = $protocol . $href;
}
return $href;
}
1;
__END__
Description: Creates an absolute uri from a url with the given protocol (e.g.,
http, ftp). If the url does not have the protocol included, it will be
appended. If no protocol is given, 'http' will be used.
Basic Usage:
create_href:
url - a string
protocol - http, ftp, etc.
Example:
HTTP Link
FTP Link
Petal-Utils-0.06/lib/Petal/Utils.pm 0000444 0001750 0001750 00000024556 10111373532 020177 0 ustar william william 0000000 0000000 package Petal::Utils;
=head1 NAME
Petal::Utils - Useful template modifiers for Petal.
=head1 SYNOPSIS
# install the default set of Petal modifiers:
use Petal::Utils;
# you can also install modifiers manually:
Petal::Utils->install( 'some_modifier', ':some_set' );
# see below for modifiers available & template syntax
=cut
use 5.006;
use strict;
use warnings::register;
use Petal::Hash;
our $VERSION = '0.06';
our $DEBUG = 0;
#------------------------------------------------------------------------------
# Cusomized import() so the user can select different plugins & sets
# use an Exporter-like syntax here:
our %PLUGIN_SET =
(
':none' => [],
':all' => [qw( :default :hash :debug )],
':default' => [qw( :text :date :logic :list :uri )],
':text' => [qw( UpperCase LowerCase UC_First Substr Printf )],
':logic' => [qw( And If Or Equal Like Decode )],
':date' => [qw( Date US_Date )],
':list' => [qw( Sort Limit Limitr)],
':hash' => [qw( Each Keys )],
':uri' => [qw( UriEscape Create_Href )],
':debug' => [qw( Dump )],
);
sub import {
my $class = shift;
push @_, ':default' unless @_;
return $class->install( @_ );
}
sub install {
my $class = shift;
foreach my $item (@_) {
next unless $item;
if ($item =~ /\A:/) {
$class->install_plugin_set( $item );
} else {
$class->install_plugin( $item );
}
}
return $class;
}
sub install_plugin_set {
my $class = shift;
my $set = shift;
my $plugins = $PLUGIN_SET{$set}
|| die "Can't install non-existent plugin set '$set'!";
# recursive so we can have sets of sets:
$class->install( @$plugins );
}
sub install_plugins {
my $class = shift;
map { $class->install_plugin( $_ ) } @_;
return $class;
}
sub install_plugin {
my $class = shift;
my $name = shift;
my $plugin = $class->find_plugin( $name );
warn "installing Petal plugin: '$name'\n" if $DEBUG;
if (UNIVERSAL::can($plugin, 'install')) {
$plugin->install;
} else {
$Petal::Hash::MODIFIERS->{"$plugin:"} = $plugin;
}
return $class;
}
sub find_plugin {
my $class = shift;
my $plugin = shift;
return \&$plugin if $class->can( $plugin );
if (my $plugin_class = $class->load_plugin( $plugin )) {
return $plugin_class;
}
die "Can't find Petal plugin: '$plugin'!";
}
sub load_plugin {
my $class = shift;
my $plugin = shift;
my $plugin_class = $class->get_plugin_class_for( $plugin );
return $plugin_class if $plugin_class->can( 'process' );
eval "require $plugin_class";
if ($@) {
warnings::warn("error loading $plugin plugin: $@") if warnings::enabled;
return;
}
return $plugin_class;
}
sub get_plugin_class_for {
my $class = shift;
my $plugin = shift;
my $plugin_class = "$class\::$plugin";
}
#------------------------------------------------------------------------------
# Plugins
## See Petal::Utils:: for plugin classes
## (plugins are now loaded as needed)
## Alternatively, use subs to insert new modifiers into the Petal Modifiers
## hash. Note that we do not get the $class value in this format.
# This style is deprecated:
# sub foo {
# my $hash = shift;
# my $args = shift;
# my $result = $hash->fetch( $args );
# return 'foo '.$result;
# }
1;
__END__
=head1 DESCRIPTION
The Petal::Utils package contains commonly used L modifiers (or plugins),
and bundles them with an easy-to-use installation interface. By default, a
set of modifiers are installed into Petal when you use this module. You can
change which modifiers are installed by naming them after the use statement:
# use the default set:
use Petal::Utils qw( :default );
# use the date set of modifiers:
use Petal::Utils qw( :date );
# use only named modifiers, plus the debug set:
use Petal::Utils qw( UpperCase Date :debug );
# don't install any modifiers
use Petal::Utils qw();
You'll find a list of plugin sets throughout this document. You can also get
a complete list by looking at the variable:
%Petal::Utils::PLUGIN_SET;
For details on how the plugins are installed, see the "Advanced Petal" section
of the L documentation.
=head1 MODIFIERS
Each modifier is listed under the set it belongs to.
=head2 :text
=over 4
=item lowercase:, lc: $string
Make the entire string lowercase.
lower
=item uppercase:, uc: $string
Make the entire string uppercase.
upper
=item uc_first: $string
Make the first letter of the string uppercase.
uc_first
=item substr: $string [offset] [length] [ellipsis]
Extract a substring from a string. Optionally add an ellipsis (...) to the
end. See also, perldoc -f substr.
string # does nothing
string # cuts the first two chars
string # extracts chars 2-7
string with ellipsis # same as above and adds an ellipsis
=item printf: format list
The printf modifier acts exactly like Perl's sprintf function to print
formatted strings.
Astro
$2.50
=back
=head2 :date
=over 4
=item date: $date
Convert a time() integer to a date string using L.
Jan 1 1970 01:00:01
=item us_date: $date
Convert an international date stamp (e.g., yyyymmdd, yyyy-mm-dd, yyyy/mm/dd)
to US format (mm/dd/yyyy).
2003-09-05
=back
=head2 :logic
=over 4
=item if: $expr1 then: $expr2 else: $expr3
Do an if/then/else test and return the value of the expression executed.
Truthfulness of $expr1 is according to Perl (e.g., non-zero, non-empty string).
Some text here...
=item or: $expr1 $expr2
Do a logical or. Truthfulness is according to Perl (e.g., non-zero, non-empty
string).
first or second = or
=item and: $expr1 $expr2
Do a logical and. Truthfulness is according to Perl (e.g., non-zero, non-empty
string).
first and second = and
=item equal:, eq: $expr1 $expr2
Test for equality. Numbers are compared with C<==>, strings with C.
Truthfulness is according to Perl (e.g., non-zero, non-empty string).
first eq second = equal
=item like: $expr $regex
Test for equality to a regular expression (see L).
name like regex = like
=item decode, decode: expression search result [search result]... [default]
The decode function has the functionality of an IF-THEN-ELSE statement. A
case-sensitive regex comparison is performed. All text strings must be
enclosed in single quotes.
'expression' is the value to compare.
'search' is the value that is compared against expression.
'result' is the value returned, if expression is equal to search.
'default. is optional. If no matches are found, the decode will return
default. If default is omitted, then the decode statement will return
null (if no matches are found).
100
# if $str = dog, returns Satchel
Astro
# if $str = cat, returns Buckey, else Satchel
=back
=head2 :list
=over 4
=item sort: $list
Sort the values in a list before returning it.
=item limit: $list count
Limit the values in a list before returning it.
=item limitr: $list count
Shuffle the list then limit the returned values to the specified count.
=back
=head2 :hash
=over 4
=item keys: $hash
Return a list of keys for a hashref. Note: It appears that values cannot be
accessed with dynamic keys. If you need the keys and values, use "each:".
=item each: $hash
Return a list of key/value pairs for a hashref.
=back
=head2 :uri
=over 4
=item uri_escape: $expr
Use L's uri_escape() to escape the return value of the expression.
get $item/key
=item create_href: $url [protocol]
Creates an absolute uri from a url with the given protocol (e.g., http, ftp --
do not include the protocol separators). If the url does not have the
protocol included, it will be appended. If no protocol is given, 'http' will
be used.
HTTP Link
FTP Link
=back
=head2 :debug
=over 4
=item dump: $expr
Dump the data strcture of the value given.
dump name: dump
=back
=head1 SUPERSETS
At the time of writing, the following supersets were available:
':none' => [],
':all' => [qw( :default :hash :debug )],
':default' => [qw( :text :date :logic :list )],
See C<%Petal::Utils::PLUGIN_SET> for an up-to-date list.
=head1 CONTRIBUTING
Contributions to the modifiers are welcome! You can suggest new modifiers to
add to the suite. You will have better luck getting your modifier added by
providing a module (see lib/Petal/Utils/And.pm for an example), a patch to
Utils.pm (with a modified PLUGIN_SET and documentation for your new modifier),
and a test suite. All modifiers are subject to the discretion of the authors.
=head1 AUTHORS
William McKee , and Steve Purkis
=head1 COPYRIGHT
Copyright (c) 2003-2004 William McKee & Steve Purkis.
This module is free software and is distributed under the same license as Perl
itself. Use it at your own risk.
=head1 THANKS
Thanks to Jean-Michel Hiver for making L available to the Perl community.
=head1 SEE ALSO
L
=cut
Petal-Utils-0.06/Changes 0000444 0001750 0001750 00000004021 10110536362 016203 0 ustar william william 0000000 0000000 Revision history for Perl extension Petal::Utils.
0.06
+ Added Contributing section to README [William McKee]
+ Added new utility function to Base.pm - split_args [William McKee, Warren S.]
+ Added new test library, t/20__Base.pm [William McKee]
+ Added limit: and limitr: modifiers and tests [William McKee]
+ Added create_href: modifier and tests [William McKee]
+ Added substr: modifier and tests [William McKee]
+ Added decode: modifier and tests [William McKee, Warren S.]
+ Added printf: modifier and tests [William McKee, Warren S.]
0.05
+ Wrote UriEscape modifier [Steve Purkis]
+ Added RELEASE.TASKS file [William McKee]
+ Updated Build.PL to create readme [Steve Purkis]
+ Cleaned up test area, broke up tests by modifier set [Steve Purkis]
0.04
(all changes by Steve Purkis)
+ Wrote If modifier.
+ Added TODO file.
* Updated INSTALL file.
+ Added 'use Carp;' to modules that needed it.
+ Added $VERSION to all modules.
0.03
* Suppressed warnings when loading plugins, introduced $DEBUG flag.
[reported by William McKee, patched by Steve Purkis]
+ Wrote get_plugin_class() to make inheriting easier. [Steve Purkis]
* Date::Format moved to required list of modules as Date plugin is in
:default set. [Steve Purkis]
0.02
* Renamed to Petal::Utils so Petal doesn't think the Utils package
is a Petal Hash modifier. [Steve Purkis]
* Moved to Module::Build. [Steve Purkis]
+ Added modifiers: Date Dump Equal(eq) And Like Sort [Steve Purkis]
+ Added import() functionality to specify modifier sets. [Steve Purkis]
* Split up modifiers into individual Petal::Utils:: modules
that are loaded as needed. [Steve Purkis]
* Restructured test directory, using File::Spec and more verbose file
names. [Steve Purkis]
* Added error handling code to existing modifiers. [Steve Purkis]
0.01
+ Initial project created Fri Sep 5 2003 [William McKee]
+ original version; created by h2xs 1.21 with options
-X -A -n Petal::Hash::Utils
Petal-Utils-0.06/MANIFEST 0000444 0001750 0001750 00000002201 10111374051 016033 0 ustar william william 0000000 0000000 Build.PL
Changes
INSTALL
lib/Petal/Utils.pm
lib/Petal/Utils/And.pm
lib/Petal/Utils/Base.pm
lib/Petal/Utils/Create_Href.pm
lib/Petal/Utils/Date.pm
lib/Petal/Utils/Decode.pm
lib/Petal/Utils/Dump.pm
lib/Petal/Utils/Each.pm
lib/Petal/Utils/Equal.pm
lib/Petal/Utils/If.pm
lib/Petal/Utils/Keys.pm
lib/Petal/Utils/Like.pm
lib/Petal/Utils/Limit.pm
lib/Petal/Utils/Limitr.pm
lib/Petal/Utils/LowerCase.pm
lib/Petal/Utils/Or.pm
lib/Petal/Utils/Printf.pm
lib/Petal/Utils/Sort.pm
lib/Petal/Utils/Substr.pm
lib/Petal/Utils/UC_First.pm
lib/Petal/Utils/UpperCase.pm
lib/Petal/Utils/UriEscape.pm
lib/Petal/Utils/US_Date.pm
Makefile.PL
MANIFEST
MANIFEST.SKIP
META.yml
README
t/01__import.t
t/02__debug.t
t/03__text.t
t/04__logic.t
t/05__date.t
t/06__list.t
t/07__hash.t
t/08__uri.t
t/20__Base.t
t/21__Limit.t
t/22__Limitr.t
t/23__Create_Href.t
t/24__Substr.t
t/25__Decode.t
t/26__Printf.t
t/data/21__limit.html
t/data/22__limitr.html
t/data/23__create_href.html
t/data/24__substr.html
t/data/25__decode.html
t/data/26__printf.html
t/data/date.html
t/data/debug.html
t/data/hash.html
t/data/list.html
t/data/logic.html
t/data/text.html
t/data/uri.html
t/LoadPetal.pm
TODO
Petal-Utils-0.06/TODO 0000444 0001750 0001750 00000000155 10107760032 015403 0 ustar william william 0000000 0000000 =======================
Petal-Utils Todo List
=======================
Pod for Utils/Base.pm
Refactor tests
Petal-Utils-0.06/META.yml 0000444 0001750 0001750 00000003776 10111374072 016200 0 ustar william william 0000000 0000000 --- #YAML:1.0
name: Petal-Utils
version: 0.06
license: perl
distribution_type: module
requires:
Date::Format: 0.01
Petal: 1.06
URI::Escape: 3.0
recommends: {}
build_requires:
Module::Build: 0.20
Test::More: 0.01
conflicts: {}
provides:
Petal::Utils:
file: lib/Petal/Utils.pm
version: 0.06
Petal::Utils::And:
file: lib/Petal/Utils/And.pm
version: 0.06
Petal::Utils::Base:
file: lib/Petal/Utils/Base.pm
version: 0.06
Petal::Utils::Create_Href:
file: lib/Petal/Utils/Create_Href.pm
version: 0.06
Petal::Utils::Date:
file: lib/Petal/Utils/Date.pm
version: 0.06
Petal::Utils::Decode:
file: lib/Petal/Utils/Decode.pm
version: 0.06
Petal::Utils::Dump:
file: lib/Petal/Utils/Dump.pm
version: 0.06
Petal::Utils::Each:
file: lib/Petal/Utils/Each.pm
version: 0.06
Petal::Utils::Equal:
file: lib/Petal/Utils/Equal.pm
version: 0.06
Petal::Utils::If:
file: lib/Petal/Utils/If.pm
version: 0.06
Petal::Utils::Keys:
file: lib/Petal/Utils/Keys.pm
version: 0.06
Petal::Utils::Like:
file: lib/Petal/Utils/Like.pm
version: 0.06
Petal::Utils::Limit:
file: lib/Petal/Utils/Limit.pm
version: 0.06
Petal::Utils::Limitr:
file: lib/Petal/Utils/Limitr.pm
version: 0.06
Petal::Utils::LowerCase:
file: lib/Petal/Utils/LowerCase.pm
version: 0.06
Petal::Utils::Or:
file: lib/Petal/Utils/Or.pm
version: 0.06
Petal::Utils::Printf:
file: lib/Petal/Utils/Printf.pm
version: 0.06
Petal::Utils::Sort:
file: lib/Petal/Utils/Sort.pm
version: 0.06
Petal::Utils::Substr:
file: lib/Petal/Utils/Substr.pm
version: 0.06
Petal::Utils::UC_First:
file: lib/Petal/Utils/UC_First.pm
version: 0.06
Petal::Utils::US_Date:
file: lib/Petal/Utils/US_Date.pm
version: 0.06
Petal::Utils::UpperCase:
file: lib/Petal/Utils/UpperCase.pm
version: 0.06
Petal::Utils::UriEscape:
file: lib/Petal/Utils/UriEscape.pm
version: 0.06
generated_by: Module::Build version 0.21
Petal-Utils-0.06/MANIFEST.SKIP 0000444 0001750 0001750 00000000167 10107510627 016617 0 ustar william william 0000000 0000000 ^_build
^Build$
^blib
~$
\.cvsignore
\.bak$
CVS
^\.DS_Store$
^Petal-Utils.+\.tar\.gz$
RELEASE.TASKS
^Makefile$
.*\.swp
Petal-Utils-0.06/INSTALL 0000444 0001750 0001750 00000001016 07730353307 015754 0 ustar william william 0000000 0000000 ===========================
Petal::Utils Installation
===========================
INSTALLATION
------------
Ideally, use the CPANPLUS or CPAN shell (`cpanp` or `cpan`) to download and
install the latest distribution from your nearest CPAN.
To install this module manually type the following:
perl Build.PL
./Build
./Build test
./Build install
Or, if you prefer to use make:
perl Makefile.PL
make
make test
make install
DEPENDENCIES
------------
See Build.PL for a full list of dependencies.
Petal-Utils-0.06/Build.PL 0000444 0001750 0001750 00000001427 10053116344 016213 0 ustar william william 0000000 0000000 #!/usr/bin/perl
=head1 NAME
Build.PL - Build script generator for Petal::Utils
=head1 SYNOPSIS
perl Build.PL
./Build test
./Build install
=cut
use lib 'lib';
use strict;
use warnings;
use File::Spec;
use Module::Build;
my $build = Module::Build->new
(
module_name => 'Petal::Utils',
dist_version_from => 'lib/Petal/Utils.pm',
create_readme => 1,
create_makefile_pl => 'passthrough',
license => 'perl',
build_requires => {
'Test::More' => '0.01',
'Module::Build' => '0.20',
},
requires => {
'Petal' => '1.06',
'Date::Format' => '0.01',
'URI::Escape' => '3.0',
},
);
$build->create_build_script;
__END__
=head1 AUTHOR
Steve Purkis
=cut
Petal-Utils-0.06/Makefile.PL 0000444 0001750 0001750 00000001604 10111374072 016665 0 ustar william william 0000000 0000000
unless (eval "use Module::Build::Compat 0.02; 1" ) {
print "This module requires Module::Build to install itself.\n";
require ExtUtils::MakeMaker;
my $yn = ExtUtils::MakeMaker::prompt
(' Install Module::Build now from CPAN?', 'y');
unless ($yn =~ /^y/i) {
warn " *** Cannot install without Module::Build. Exiting ...\n";
exit 1;
}
require Cwd;
require File::Spec;
require CPAN;
# Save this 'cause CPAN will chdir all over the place.
my $cwd = Cwd::cwd();
my $makefile = File::Spec->rel2abs($0);
CPAN::Shell->install('Module::Build::Compat');
chdir $cwd or die "Cannot chdir() back to $cwd: $!";
exec $^X, $makefile, @ARGV; # Redo now that we have Module::Build
}
Module::Build::Compat->run_build_pl(args => \@ARGV);
Module::Build::Compat->write_makefile();
Petal-Utils-0.06/README 0000444 0001750 0001750 00000017622 10111374072 015602 0 ustar william william 0000000 0000000 NAME
Petal::Utils - Useful template modifiers for Petal.
SYNOPSIS
# install the default set of Petal modifiers:
use Petal::Utils;
# you can also install modifiers manually:
Petal::Utils->install( 'some_modifier', ':some_set' );
# see below for modifiers available & template syntax
DESCRIPTION
The Petal::Utils package contains commonly used Petal modifiers (or
plugins), and bundles them with an easy-to-use installation interface.
By default, a set of modifiers are installed into Petal when you use
this module. You can change which modifiers are installed by naming them
after the use statement:
# use the default set:
use Petal::Utils qw( :default );
# use the date set of modifiers:
use Petal::Utils qw( :date );
# use only named modifiers, plus the debug set:
use Petal::Utils qw( UpperCase Date :debug );
# don't install any modifiers
use Petal::Utils qw();
You'll find a list of plugin sets throughout this document. You can also
get a complete list by looking at the variable:
%Petal::Utils::PLUGIN_SET;
For details on how the plugins are installed, see the "Advanced Petal"
section of the Petal documentation.
MODIFIERS
Each modifier is listed under the set it belongs to.
:text
lowercase:, lc: $string
Make the entire string lowercase.
lower
uppercase:, uc: $string
Make the entire string uppercase.
upper
uc_first: $string
Make the first letter of the string uppercase.
uc_first
substr: $string [offset] [length] [ellipsis]
Extract a substring from a string. Optionally add an ellipsis (...)
to the end. See also, perldoc -f substr.
string # does nothing
string # cuts the first two chars
string # extracts chars 2-7
string with ellipsis # same as above and adds an ellipsis
printf: format list
The printf modifier acts exactly like Perl's sprintf function to
print formatted strings.
Astro
$2.50
:date
date: $date
Convert a time() integer to a date string using Date::Format.
Jan 1 1970 01:00:01
us_date: $date
Convert an international date stamp (e.g., yyyymmdd, yyyy-mm-dd,
yyyy/mm/dd) to US format (mm/dd/yyyy).
2003-09-05
:logic
if: $expr1 then: $expr2 else: $expr3
Do an if/then/else test and return the value of the expression
executed. Truthfulness of $expr1 is according to Perl (e.g.,
non-zero, non-empty string).
Some text here...
or: $expr1 $expr2
Do a logical or. Truthfulness is according to Perl (e.g., non-zero,
non-empty string).
first or second = or
and: $expr1 $expr2
Do a logical and. Truthfulness is according to Perl (e.g., non-zero,
non-empty string).
first and second = and
equal:, eq: $expr1 $expr2
Test for equality. Numbers are compared with "==", strings with
"eq". Truthfulness is according to Perl (e.g., non-zero, non-empty
string).
first eq second = equal
like: $expr $regex
Test for equality to a regular expression (see perlre).
name like regex = like
decode, decode: expression search result [search result]... [default]
The decode function has the functionality of an IF-THEN-ELSE
statement. A case-sensitive regex comparison is performed. All text
strings must be enclosed in single quotes.
'expression' is the value to compare.
'search' is the value that is compared against expression.
'result' is the value returned, if expression is equal to search.
'default. is optional. If no matches are found, the decode will return
default. If default is omitted, then the decode statement will return
null (if no matches are found).
100
# if $str = dog, returns Satchel
Astro
# if $str = cat, returns Buckey, else Satchel
:list
sort: $list
Sort the values in a list before returning it.
limit: $list count
Limit the values in a list before returning it.
limitr: $list count
Shuffle the list then limit the returned values to the specified
count.
:hash
keys: $hash
Return a list of keys for a hashref. Note: It appears that values
cannot be accessed with dynamic keys. If you need the keys and
values, use "each:".
each: $hash
Return a list of key/value pairs for a hashref.
:uri
uri_escape: $expr
Use URI::Escape's uri_escape() to escape the return value of the
expression.
get $item/key
create_href: $url [protocol]
Creates an absolute uri from a url with the given protocol (e.g.,
http, ftp -- do not include the protocol separators). If the url
does not have the protocol included, it will be appended. If no
protocol is given, 'http' will be used.
HTTP Link
FTP Link
:debug
dump: $expr
Dump the data strcture of the value given.
dump name: dump
SUPERSETS
At the time of writing, the following supersets were available:
':none' => [],
':all' => [qw( :default :hash :debug )],
':default' => [qw( :text :date :logic :list )],
See %Petal::Utils::PLUGIN_SET for an up-to-date list.
CONTRIBUTING
Contributions to the modifiers are welcome! You can suggest new
modifiers to add to the suite. You will have better luck getting your
modifier added by providing a module (see lib/Petal/Utils/And.pm for an
example), a patch to Utils.pm (with a modified PLUGIN_SET and
documentation for your new modifier), and a test suite. All modifiers
are subject to the discretion of the authors.
AUTHORS
William McKee , and Steve Purkis
COPYRIGHT
Copyright (c) 2003-2004 William McKee & Steve Purkis.
This module is free software and is distributed under the same license
as Perl itself. Use it at your own risk.
THANKS
Thanks to Jean-Michel Hiver for making Petal available to the Perl
community.
SEE ALSO
Petal