String-Print-0.15/0000755000175000001440000000000012310534202014505 5ustar00markovusers00000000000000String-Print-0.15/META.yml0000644000175000001440000000076012310534202015761 0ustar00markovusers00000000000000--- abstract: 'printf extensions' author: - 'Mark Overmeer' build_requires: ExtUtils::MakeMaker: 0 configure_requires: ExtUtils::MakeMaker: 0 dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120630' license: perl meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 name: String-Print no_index: directory: - t - inc requires: Encode: 0 Test::More: 0.86 Unicode::GCString: 0 version: 0.15 String-Print-0.15/xt/0000755000175000001440000000000012310534202015140 5ustar00markovusers00000000000000String-Print-0.15/xt/99pod.t0000644000175000001440000000041612307353045016304 0ustar00markovusers00000000000000#!/usr/bin/env perl use warnings; use strict; use Test::More; BEGIN { eval "use Test::Pod 1.00"; plan skip_all => "Test::Pod 1.00 required for testing POD" if $@; plan skip_all => "devel home uses OODoc" if $ENV{MARKOV_DEVEL}; } all_pod_files_ok(); String-Print-0.15/Makefile.PL0000644000175000001440000000132612310534201016460 0ustar00markovusers00000000000000use ExtUtils::MakeMaker; use 5.010; my $version = '0.15'; my %prereq = ( Test::More => 0.86 , Unicode::GCString => 0 , Encode => 0 ); WriteMakefile ( NAME => 'String::Print' , VERSION => $version , PREREQ_PM => \%prereq , AUTHOR => 'Mark Overmeer' , ABSTRACT => 'printf extensions' , LICENSE => 'perl' ); sub MY::postamble { <<'__POSTAMBLE' } # for OODoc's oodist, DIST RAWDIR = ../public_html/string-print/raw DISTDIR = ../public_html/string-print/source LICENSE = artistic # for OODoc's oodist, POD FIRST_YEAR = 2013 EMAIL = perl@overmeer.net WEBSITE = http://perl.overmeer.net/log-report/ EXTENDS = __POSTAMBLE String-Print-0.15/README0000644000175000001440000000144012307353045015376 0ustar00markovusers00000000000000=== README for String-Print version 0.14 = Generated on Mon Mar 10 16:11:33 2014 by OODoc 2.01 There are various ways to install this module: (1) if you have a command-line, you can do: perl -MCPAN -e 'install ' (2) if you use Windows, have a look at http://ppm.activestate.com/ (3) if you have downloaded this module manually (as root/administrator) gzip -d String-Print-0.14.tar.gz tar -xf String-Print-0.14.tar cd String-Print-0.14 perl Makefile.PL make # optional make test # optional make install For usage, see the included manual-pages or http://search.cpan.org/dist/String-Print-0.14/ Please report problems to http://rt.cpan.org/Dist/Display.html?Queue=String-Print String-Print-0.15/ChangeLog0000644000175000001440000000227512310534201016264 0ustar00markovusers00000000000000 ========== version history of String::Print version 0.15: Fri Mar 14 09:06:18 CET 2014 Fixes: - t/11modif.t regression test, where float may get ',' under some locales [cpantesters] version 0.14: Mon Mar 10 16:11:30 CET 2014 Improvements: - changed documentation style version 0.13: Sun Jan 5 16:51:09 CET 2014 Improvements: - docs: fune-tuning - serializer for SCALAR - accept blanks around names of interpolated variable names - accept digits in variable names, not as first character. version 0.12: Mon Apr 29 09:16:23 CEST 2013 Changes: - %c --> %S [Amsterdam Perl Mongers] Improvements: - docs: correct syntax for links to alternative modules. - docs: PND -> GBP [H.Merijn Brand] version 0.11: Tue Apr 16 12:27:54 CEST 2013 Fixes: - require perl 5.10 for '//' operator [cpantesters] - fix tests to use gmtime, not localtime [cpantesters] - some documentation layout improvements [search.cpan.org] - in examples: strftime "%TT%FZ" --> "%FT%TZ", of course - in tests: Windows doesn't support %T nor %F, expand format - any format with strings must be transformed into utf8 version 0.10: Mon Apr 15 12:06:32 CEST 2013 - implementation, documentation and regression tests. String-Print-0.15/lib/0000755000175000001440000000000012310534202015253 5ustar00markovusers00000000000000String-Print-0.15/lib/String/0000755000175000001440000000000012310534202016521 5ustar00markovusers00000000000000String-Print-0.15/lib/String/Print.pod0000644000175000001440000003744512310534201020335 0ustar00markovusers00000000000000=encoding utf8 =head1 NAME String::Print - printf alternative =head1 SYNOPSIS ### Functional interface use String::Print qw/printi printp/, %config; # interpolation of arrays and hashes printi 'age {years}', years => 12; printi 'price-list: {prices%.2f}', prices => \@prices, _join => "+"; printi 'dump: {hash}', hash => \%config; # same with positional parameters printp 'age %d", 12; printp 'price-list: %.2f', \@prices; printp 'dump: %s', \%settings; ### Object Oriented interface use String::Print 'oo'; # import nothing my $f = String::Print->new(%config); # same, called directly $f->printi('age {years}', years => 12); $f->printp('age %d', 12); ### via Log::Report's __* functions use Log::Report::Optional; print __x"age {years}", years => 12; =head1 DESCRIPTION This module inserts values into (translated) strings. It provides C and C alternatives via both an object oriented and a functional interface. Read in the L chapter below, why this module provides a better alternative for C. Also, some extended B can be found there. Take a look at them first, when you start using this module! =head1 METHODS =head2 The Object Oriented interface See functions L, L, L, and L: you can also call them as method. use String::Print 'oo'; my $f = String::Print->new(%config); $f->printi($format, @params); # exactly the same functionality: use String::Print 'printi', %config; printi $format, @params; The Object Oriented interface wins when you need the same configuration in multiple source files, or when you need different configurations within one program. In these cases, the hassle of explicitly using the object has some benefits. =head2 Constructors =over 4 =item String::Print-EB(%options) -Option --Default modifiers [ qr/^%\S+/ = \&format_printf]> serializers =over 2 =item modifiers => ARRAY Add one or more modifier handlers to power of the formatter. They will get preference over the predefined modifiers, but lower than the modifiers passed to C itself. =item serializers => HASH|ARRAY How to serialize data elements. =back example: my $f = String::Print->new ( modifiers => [ EUR => sub {sprintf "%5.2f e", $_[0]} ] , serializers => [ UNDEF => sub {'-'} ] ); $f->printi("price: {p EUR}", p => 3.1415); # price: ␣␣3.14 e $f->printi("count: {c}", c => undef); # count: - =back =head2 Attributes =over 4 =item $obj-EB(PAIRS) The PAIRS are a combination of an selector and a CODE which processes the value when the modifier matches. The selector is a string or (preferred) a regular expression. Later modifiers with the same name overrule earlier definitions. You may also specify an ARRAY of modifiers per C. See section L about the details. =back =head1 FUNCTIONS The functional interface creates a hidden object. You may import any of these functions explicitly, or all together by not specifying the names. =over 4 =item B( [$fh], $format, PAIRS|HASH ) Calls L to fill the data in PAIRS or HASH in $format, and then sends it to the $fh (by default the selected file) open my $fh, '>', $file; printi $fh, ... printi \*STDERR, ... =item B( [$fh], $format, PAIRS|HASH ) Calls L to fill the data in PAIRS or HASH in $format, and then sends it to the $fh (by default the selected file) =item B($format, PAIRS|HASH) The $format refers to some string, maybe the result of a translation. The PAIRS (which may be passed as LIST or HASH) contains a mixture of special and normal variables to be filled in. The names of the special variables (the options) start with an underscore (C<_>). -Option --Default _append undef _count undef _join ', ' _prepend undef =over 2 =item _append => STRING|OBJECT Text as STRING appended after $format, without interpolation. =item _count => INTEGER Result of the translation process: when Log::Report subroutine __xn is are used for count-sensitive translation. Those function may add more specials to the parameter list. =item _join => STRING Which STRING to use when an ARRAY is being filled-in as parameter. =item _prepend => STRING|OBJECT Text as STRING prepended before $format, without interpolation. This may also be an OBJECT which gets stringified, but variables not filled-in. =back =item B($format, LIST, PAIRS) Where L uses named parameters --especially useful when the strings need translation-- this function stays close to the standard C. All features of POSIX formats are supported. This should say enough: you can use C<%3$0#5.*d>, if you like. It may be useful to know that the positional $format is rewritten and then fed into L. B with the length of the LIST: superfluous parameter PAIRS are passed along to C, and should only contain "specials". example: of the rewrite # positional parameters my $x = sprintp "dumpfiles: %s\n", \@dumpfiles , _join => ':'; # is rewriten into, and then processed as my $x = sprinti "dumpfiles: {filenames}\n" , filenames => \@dumpfiles, _join => ':'; =back =head1 DETAILS =head2 Why use C, not C? The C function is provided by Perl's CORE; you do not need to install any module to use it. Why would you use consider using this module? =over 4 =item translating C uses positional parameters, where L uses names to refer to the values to be filled-in. Especially in a set-up with translations, where the format strings get extracted into PO-files, it is much clearer to use names. This is also a disadvantage of L =item pluggable serializers C supports serialization for specific data-types: how to interpolate C, HASHes, etc. =item pluggable modifiers Especially useful in context of translations, the FORMAT string may contain (language specific) helpers to insert the values correctly. =item correct use of utf8 Sized string formatting in C is broken: it takes your string as bytes, not Perl strings (which may be utf8). In unicode, one "character" may use many bytes. Also, some characters are displayed double wide, for instance in Chinese. The L implementation will use Unicode::GCString for correct behavior. =back =head2 Three components To fill-in a FORMAT, three clearly separated components play a role: =over 4 =item 1. modifiers How to change the provided values, for instance to hide locale differences. =item 2. serializer How to represent (the modified) the values correctly, for instance C and ARRAYs. =item 3. conversion The standard UNIX format rules, like C<%d>. One conversion rule has been added 'S', which provides unicode correct behavior. =back Simplified: # sprinti() replaces "{$key$modifiers$conversion}" by $conversion->($serializer->($modifiers->($args{$key}))) # sprintp() replaces "%pos{$modifiers}$conversion" by $conversion->($serializer->($modifiers->($arg[$pos]))) Example: printi "price: {price € %-10s}", price => $cost; printp "price: %-10{€}s", $cost; $conversion = column width %-10s $serializer = show float as string $modifier = € to local currency $value = $cost (in €) =head2 Interpolation: Serialization The 'interpolation' functions have named VARIABLES to be filled-in, but also additional OPTIONS. To distinguish between the OPTIONS and VARIABLES (both a list of key-value pairs), the keys of the OPTIONS start with an underscore C<_>. As result of this, please avoid the use of keys which start with an underscore in variable names. On the other hand, you are allowed to interpolate OPTION values in your strings. There is no way of checking beforehand whether you have provided all values to be interpolated in the translated string. When you refer to value which is missing, it will be interpreted as C. =over 4 =item CODE When a value is passed as CODE reference, that function will get called to return the value to be filled in. For interpolating, the following rules apply: =item strings Simple scalar values are interpolated "as is" =item SCALAR Takes the value where the scalar reference points to. =item ARRAY All members will be interpolated with C<,␣> between the elements. Alternatively (maybe nicer), you can pass an interpolation parameter via the C<_join> OPTION. printi "matching files: {files}", files => \@files, _join => ', ' =item HASH By default, HASHes are interpolated with sorted keys, $key => $value, $key2 => $value2, ... There is no quoting on the keys or values (yet). Usually, this will produce an ugly result anyway. =item Objects With the C parameter, you can overrule the interpolation of above defaults, but also add rules for your own objects. By default, objects get stringified. serialization => [ $myclass => \&name_in_reverse ] sub name_in_reverse($$$) { my ($formatter, $object, $args) = @_; # the $args are all parameters to be filled-in scalar reverse $object->name; } =back =head2 Interpolation: Modifiers Modifiers are used to change the value to be inserted, before the characters get interpolated in the line. =head3 Modifiers: unix format Next to the name, you can specify a format code. With (gnu) C, you often see this: printf gettext("approx pi: %.6f\n"), PI; Locale::TextDomain has two ways: printf __"approx pi: %.6f\n", PI; print __x"approx pi: {approx}\n", approx => sprintf("%.6f", PI); The first does not respect the wish to be able to reorder the arguments during translation (although there are ways to work around that) The second version is quite long. The content of the translation table differs between the examples. With C, above syntaxes do work, but you can also do: # with optional translations print __x"approx pi: {pi%.6f}\n", pi => PI; The base for C<__x()> is the L provided by this module. Internally, it will call C to fill in parameters: printi "approx pi: {pi%.6f}\n", pi => PI; Another example: printi "{perms} {links%2d} {user%-8s} {size%10d} {fn}\n" , perms => '-rw-r--r--', links => 7, user => 'me' , size => 12345, fn => $filename; An additional advantage is the fact that not all languages produce comparable length strings. Now, the translators can take care that the layout of tables is optimal. Above example in L syntax, shorter but less maintainable: printp "%s %2d %-8s 10d %s\n" , '-rw-r--r--', 7, 'me', 12345, $filename; =head3 Modifiers: unix format improvements The POSIX C does not handle unicode strings. Perl does understand that the 's' modifier may need to insert utf8 so does not count bytes but characters. C does not use characters but "grapheme clusters" via Unicode::GCString. Now, also composed characters do work correctly. Additionally, you can use the B to count in columns. In fixed-width fonts, graphemes can have width 0, 1 or 2. For instance, Chinese characters have width 2. When printing in fixed-width, this 'S' is probably the better choice over 's'. When the field does not specify its width, then there is no performance penalty for using 'S'. =head3 Modifiers: private modifiers You may pass your own modifiers. A modifier consists of a selector and a CODE, which is called when the selector matches. The selector is either a string or a regular expression. # in Object Oriented syntax: my $f = String::Print->new ( modifiers => [ qr/[€₤]/ => \&money ] ); # in function syntax: use String::Print 'printi', 'sprinti' , modifiers => [ qr/[€₤]/ => \&money ]; # the implementation: sub money$$$$) { my ($formatter, $modif, $value, $args) = @_; $modif eq '€' ? sprintf("%.2f EUR", $value+0.0001) : $modif eq '₤' ? sprintf("%.2f GBP", $value/1.16+0.0001) : 'ERROR'; } Using L makes it a little shorter, but will become quite complex when there are more parameter in one string. printi "price: {p€}", p => $pi; # price: 3.14 EUR printi "price: {p₤}", p => $pi; # price: 2.71 GBP printp "price: %{€}s", $pi; # price: 3.14 EUR printp "price: %{₤}s", $pi; # price: 2.71 GBP This is very useful in the translation context, where the translator can specify abstract formatting rules. As example, see the (GNU) gettext files, in the translation table for Dutch into English. The translator tells us which currency to use in the display. msgid "kostprijs: {p€}" msgstr "price: {p₤}" Another example. Now, we want to add timestamps. In this case, we decide for modifier names in C<\w>, so we need a blank to separate the paramter from the modifer. use POSIX qw/strftime/; use String::Print modifiers => [ qr/T|DT|D/ => \&_timestamp ]; sub _timestamp($$$$) { my ($formatter, $modif, $value, $args) = @_; my $time_format = $modif eq 'T' ? '%T' : $modif eq 'D' ? '%F' : $modif eq 'DT' ? '%FT%TZ' : 'ERROR'; strftime $time_format, gmtime($value); }; printi "time: {t T}", t => $now; # time: 10:59:17 printi "date: {t D }", t => $now; # date: 2013-04-13 printi "both: {t DT}", t => $now; # both: 2013-04-13T10:59:17Z printp "time: %{T}s", $now; # time: 10:59:17 printp "date: %{D}s", $now; # date: 2013-04-13 printp "both: %{DT}s", $now; # both: 2013-04-13T10:59:17Z =head3 Modifiers: stacking You can add more than one modifier. The modifiers detect the extend of their own information (via a regular expression), and therefore the formatter understands where one ends and the next begins. The modifiers are called in order: printi "price: {p€%9s}\n", p => $p; # price: ␣␣␣123.45 printi ">{t T%10s}<", t => $now; # >␣␣12:59:17< printp "price: %9{€}s\n", $p; # price: ␣␣␣123.45 printp ">%10{T}s<", $now; # >␣␣12:59:17< =head2 Compared to other modules on CPAN There are a quite a number of modules on CPAN which extend the functionality of C. To name a few: L, L, L, L, L, L, L, and L. They are all slightly different. When the C module was created, none of the modules mentioned above handled unicode correctly. Global configuration of serializers and modifiers is also usually not possible, sometimes provided per explicit function call. Only C cleanly separates the roles of serializers, modifiers, and conversions. C is nicely integrated with Log::Report. =head1 SEE ALSO This module is part of String-Print distribution version 0.15, built on March 14, 2014. Website: F =head1 LICENSE Copyrights 2013-2014 by [Mark Overmeer]. For other contributors see ChangeLog. This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See F String-Print-0.15/lib/String/Print.pm0000644000175000001440000001567012310534201020163 0ustar00markovusers00000000000000# Copyrights 2013-2014 by [Mark Overmeer]. # For other contributors see ChangeLog. # See the manual pages for details on the licensing terms. # Pod stripped from pm file by OODoc 2.01. use warnings; use strict; package String::Print; our $VERSION = '0.15'; #use Log::Report::Optional 'log-report'; use Encode qw/is_utf8 decode/; use Unicode::GCString (); my @default_modifiers = ( qr/%\S+/ => \&_format_printf ); my %default_serializers = ( UNDEF => sub { 'undef' } , '' => sub { $_[1] } , SCALAR => sub { ${$_[1]} // shift->{LRF_seri}{UNDEF}->(@_) } , ARRAY => sub { my $v = $_[1]; my $join = $_[2]{_join} // ', '; join $join, map +($_ // 'undef'), @$v; } , HASH => sub { my $v = $_[1]; join ', ', map "$_ => ".($v->{$_} // 'undef'), sort keys %$v; } # CODE value has different purpose ); sub new(@) { my $class = shift; (bless {}, $class)->init( {@_} ) } sub init($) { my ($self, $args) = @_; my $modif = $self->{LRF_modif} = [ @default_modifiers ]; if(my $m = $args->{modifiers}) { unshift @$modif, @$m; } my $s = $args->{serializers} || {}; my $seri = $self->{LRF_seri} = { %default_serializers, (ref $s eq 'ARRAY' ? @$s : %$s) }; $self; } sub import(@) { my $class = shift; my ($oo, %func); while(@_) { last if $_[0] !~ m/^s?print[ip]$/; $func{shift()} = 1; } if(@_ && $_[0] eq 'oo') # only object oriented interface { shift @_; @_ and die "no options allowed at import with oo interface"; return; } my $all = !keys %func; my $f = $class->new(@_); # OO encapsulated my ($pkg) = caller; no strict 'refs'; *{"$pkg\::printi"} = sub { $f->printi(@_) } if $all || $func{printi}; *{"$pkg\::sprinti"} = sub { $f->sprinti(@_) } if $all || $func{sprinti}; *{"$pkg\::printp"} = sub { $f->printp(@_) } if $all || $func{printp}; *{"$pkg\::sprintp"} = sub { $f->sprintp(@_) } if $all || $func{sprintp}; $class; } #------------- sub addModifiers(@) {my $self = shift; unshift @{$self->{LRF_modif}}, @_} #------------------- sub sprinti($@) { my ($self, $format) = (shift, shift); my $args = @_==1 ? shift : {@_}; $args->{_join} //= ', '; my $result = is_utf8($format) ? $format : decode(latin1 => $format); # quite hard to check for a bareword :( $result =~ s/\{\s* ( [\pL\p{Pc}\pM]\w* )\s*( [^}]*? )\s*\}/ $self->_expand($1,$2,$args)/gxe; $result = $args->{_prepend} . $result if defined $args->{_prepend}; $result .= $args->{_append} if defined $args->{_append}; $result; } sub _expand($$$) { my ($self, $key, $modifier, $args) = @_; my $value = $args->{$key}; $value = $value->($self, $key, $args) while ref $value eq 'CODE'; my $mod; STACKED: while(length $modifier) { my @modif = @{$self->{LRF_modif}}; while(@modif) { my ($regex, $callback) = (shift @modif, shift @modif); $modifier =~ s/^($regex)\s*// or next; $value = $callback->($self, $1, $value, $args); next STACKED; } return "{unknown modifier '$modifier'}"; } my $seri = $self->{LRF_seri}{defined $value ? ref $value : 'UNDEF'}; $seri ? $seri->($self, $value, $args) : "$value"; } # See dedicated section in explanation in DETAILS sub _format_printf($$$$) { my ($self, $format, $value, $args) = @_; # be careful, often $format doesn't eat strings defined $value or return 'undef'; use locale; if(ref $value eq 'ARRAY') { @$value or return '(none)'; return [ map $self->_format_print($format, $_, $args), @$value ] ; } elsif(ref $value eq 'HASH') { keys %$value or return '(none)'; return { map +($_ => $self->_format_print($format, $value->{$_}, $args)) , keys %$value } ; } $format =~ m/^\%([-+ ]?)([0-9]*)(?:\.([0-9]*))?([sS])$/ or return sprintf $format, $value; # simple: not a string my ($padding, $width, $max, $u) = ($1, $2, $3, $4); # String formats like %10s or %-3.5s count characters, not width. # String formats like %10S or %-3.5S are subject to column width. # The latter means: minimal 3 chars, max 5, padding right with blanks. # All inserted strings are upgraded into utf8. my $s = Unicode::GCString->new ( is_utf8($value) ? $value : decode(latin1 => $value)); my $pad; if($u eq 'S') { # too large to fit return $value if !$max && $width && $width <= $s->columns; # wider than max. Waiting for $s->trim($max) if $max, see # https://rt.cpan.org/Public/Bug/Display.html?id=84549 $s->substr(-1, 1, '') while $max && $s->columns > $max; $pad = $width ? $width - $s->columns : 0; } else # $u eq 's' { return $value if !$max && $width && $width <= length $s; $s->substr($max, length($s)-$max, '') if $max && length $s > $max; $pad = $width ? $width - length $s : 0; } $pad==0 ? $s->as_string : $padding eq '-' ? $s->as_string . (' ' x $pad) : (' ' x $pad) . $s->as_string; } sub printi($$@) { my $self = shift; my $fh = ref $_[0] eq 'GLOB' ? shift : select; $fh->print($self->sprinti(@_)); } sub printp($$@) { my $self = shift; my $fh = ref $_[0] eq 'GLOB' ? shift : select; $fh->print($self->sprintp(@_)); } sub _printp_rewrite($) { my @params = @{$_[0]}; my $printp = $params[0]; my ($printi, @iparam); my ($pos, $maxpos) = (1, 1); while(length $printp && $printp =~ s/^([^%]+)//s) { $printi .= $1; length $printp or last; if($printp =~ s/^\%\%//) { $printi .= '%'; next; } $printp =~ s/\%(?:([0-9]+)\$)? # 1=positional ([-+0 \#]*) # 2=flags ([0-9]*|\*)? # 3=width (?:\.([0-9]*|\*))? # 4=precission (?:\{ ([^}]*) \})? # 5=modifiers (\w) # 6=conversion //x or die "format error at '$printp' in '$params[0]'"; $pos = $1 if $1; my $width = !defined $3 ? '' : $3 eq '*' ? $params[$pos++] : $3; my $prec = !defined $4 ? '' : $4 eq '*' ? $params[$pos++] : $4; my $modif = !defined $5 ? '' : $5; my $valpos= $pos++; $maxpos = $pos if $pos > $maxpos; push @iparam, "_$valpos" => $params[$valpos]; my $format= '%'.$2.($width || '').($prec ? ".$prec" : '').$6; $format = '' if $format eq '%s'; my $sep = $modif.$format =~ m/^\w/ ? ' ' : ''; $printi .= "{_$valpos$sep$modif$format}"; } splice @params, 0, $maxpos, @iparam; ($printi, \@params); } sub sprintp(@) { my $self = shift; my ($i, $iparam) = _printp_rewrite \@_; $self->sprinti($i, {@$iparam}); } #------------------- 1; String-Print-0.15/MANIFEST0000644000175000001440000000053612310534202015642 0ustar00markovusers00000000000000ChangeLog MANIFEST Makefile.PL README lib/String/Print.pm lib/String/Print.pod t/00use.t t/10serial.t t/11modif.t t/20prewrite.t t/30examp_oo.t t/31examp_fun.t t/40utf8.t xt/99pod.t META.yml Module YAML meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) String-Print-0.15/t/0000755000175000001440000000000012310534202014750 5ustar00markovusers00000000000000String-Print-0.15/t/10serial.t0000644000175000001440000000307212307353045016571 0ustar00markovusers00000000000000#!/usr/bin/env perl # Serialize variables when sprintid use warnings; use strict; use Test::More tests => 16; use String::Print; my $f = String::Print->new; isa_ok($f, 'String::Print'); is($f->sprinti("#{v}#", v => undef), '#undef#', 'UNDEF'); is($f->sprinti("#{v}#", v => ''), '##' , 'empty string'); is($f->sprinti("#{v}#", v => 42), '#42#' , 'string'); is($f->sprinti("#{v}#", v => [12,13]),'#12, 13#', 'ARRAY'); is($f->sprinti("#{v}#", v => [14,15], _join => ' '),'#14 15#'); { local $" = ':'; is($f->sprinti("#{v}#", v => [16,17], _join => $"), '#16:17#'); } is($f->sprinti("#{v}#", v => {a => 3, b => 5}) ,'#a => 3, b => 5#', 'HASH'); is($f->sprinti("#{v}#", v => sub {18}),'#18#', 'CODE'); is($f->sprinti("#{v}#", v => sub {sub {19}}),'#19#', 'CODE CODE'); is($f->sprinti("#{v}#", v => \50),'#50#', 'SCALAR'); is($f->sprinti("#{v}#", v => \undef),'#undef#', 'SCALAR undef'); my $g = String::Print->new ( serializers => [ UNDEF => sub {'(undef)'} , ARRAY => sub {join '|', reverse @{$_[1]} } , MyObj => \&name_in_reverse ] ); isa_ok($g, 'String::Print'); is($g->sprinti("#{v}#", v => undef), '#(undef)#'); is($g->sprinti("#{v}#", v => [8..13]),'#13|12|11|10|9|8#'); # ### Object interpolation # used as example in man-page # { package MyObj; sub name() {shift->{name}} } my $obj = bless {name => 'my-name'}, 'MyObj'; is($g->sprinti("#{v}#", v => $obj),'#eman-ym#'); sub name_in_reverse($$$) { my ($formatter, $object, $args) = @_; # the $args are all parameters to be filled-in scalar reverse $object->name; } String-Print-0.15/t/40utf8.t0000644000175000001440000000106712307353045016205 0ustar00markovusers00000000000000#!/usr/bin/env perl # difficult utf8 situations use warnings; use strict; use utf8; use Test::More tests => 7; use Encode qw/is_utf8/; use String::Print 'sprintp'; my $latin1 = chr 230; # æ ok(!is_utf8 $latin1); my $format = "a${latin1}b%sc"; my $out1 = sprintp $format, 'z'; ok(is_utf8($out1), 'formatted with normal param'); is($out1, 'aæbzc'); my $out2 = sprintp $format, $latin1; ok(is_utf8($out2), 'formatted with latin1'); is($out2, 'aæbæc'); my $out3 = sprintp $format, 'Ø'; ok(is_utf8($out3), 'formatted with utf8'); is($out3, 'aæbØc'); String-Print-0.15/t/31examp_fun.t0000644000175000001440000000113312307353045017273 0ustar00markovusers00000000000000#!/usr/bin/env perl # Demonstrate the functional examples use warnings; use strict; use Test::More tests => 4; use String::Print 'sprinti', 'sprintp' , modifiers => [ EUR => sub { sprintf "%5.2f e", $_[2] } ] , serializers => [ UNDEF => sub {'-'} ]; is(sprinti("price: {p EUR}#", p => 3.1415), 'price: 3.14 e#'); is(sprinti("count: {c}#", c => undef), 'count: -#'); my @dumpfiles = qw/f1 f2/; is(sprintp("dumpfiles: %s\n", \@dumpfiles, _join => ', ') , "dumpfiles: f1, f2\n"); is(sprinti("dumpfiles: {filenames}\n",filenames => \@dumpfiles, _join => ', ') , "dumpfiles: f1, f2\n"); String-Print-0.15/t/00use.t0000644000175000001440000000120612307353045016102 0ustar00markovusers00000000000000#!/usr/bin/env perl use warnings; use strict; use Test::More tests => 1; # The versions of the following packages are reported to help understanding # the environment in which the tests are run. This is certainly not a # full list of all installed modules. my @show_versions = qw/ Test::More Unicode::GCString /; warn "Perl $]\n"; foreach my $package (sort @show_versions) { eval "require $package"; my $report = !$@ ? "version ". ($package->VERSION || 'unknown') : $@ =~ m/^Can't locate/ ? "not installed" : "reports error"; warn "$package $report\n"; } use_ok('String::Print'); String-Print-0.15/t/20prewrite.t0000644000175000001440000000334412307353045017156 0ustar00markovusers00000000000000#!/usr/bin/env perl # Test printp rewrite use warnings; use strict; use Test::More tests => 102; use String::Print; sub rewrite($$$) { my ($pargs, $i, $iargs) = @_; my $p = $pargs->[0]; my ($goti, $gota) = String::Print::_printp_rewrite($pargs); #use Data::Dumper; #warn Dumper $goti, $gota; ok(defined $goti, "rewrite $p"); is($goti, $i, "into $i"); cmp_ok(scalar @$iargs, '==', scalar @$gota, 'check returned arg length'); foreach(my $i=0; $i<@$iargs; $i++) { cmp_ok($iargs->[$i], 'eq', $gota->[$i], "param $i = $iargs->[$i]"); } } rewrite(['aap'], 'aap', []); rewrite(['a%db', '42'], 'a{_1%d}b', [_1 => 42] ); rewrite(['a%sb', '43'], 'a{_1}b', [_1 => 43] ); rewrite(['a%5sb', '44'], 'a{_1%5s}b', [_1 => 44] ); rewrite(['a%.3sb', '45'], 'a{_1%.3s}b', [_1 => 45] ); rewrite(['a%2.3sb', '46'], 'a{_1%2.3s}b', [_1 => 46] ); rewrite(['a%2.3{T}sb', '47'], 'a{_1 T%2.3s}b', [_1 => 47] ); rewrite(['a%-2sb', '48'], 'a{_1%-2s}b', [_1 => 48] ); rewrite(['a%-.3sb', '49'], 'a{_1%-.3s}b', [_1 => 49] ); rewrite(['a%sb c%sd', '50', 51], 'a{_1}b c{_2}d', [_1 => 50, _2 => 51] ); rewrite(['a%*db c%*sd', 3, 4, 5, 6, x => 5] , 'a{_2%3d}b c{_4%5s}d' , [_2 => 4, _4 => 6, x => 5] ); rewrite(['a%2.*db c%.*sd', 3, 4, 5, 6, y => 6] , 'a{_2%2.3d}b c{_4%.5s}d' , [_2 => 4, _4 => 6, y => 6] ); rewrite(['a%*.*sb', 11, 12, 13, r => 42], 'a{_3%11.12s}b', [_3 => 13, r => 42]); rewrite(['a%1$sb c%2$dd', 14, 15, z => 13], 'a{_1}b c{_2%d}d' , [_1 => 14, _2 => 15, z => 13] ); rewrite(['a%2$-1.6sb c%1$dd', 16, 17, z => 18], 'a{_2%-1.6s}b c{_1%d}d' , [_2 => 17, _1 => 16, z => 18] ); rewrite(['a%2$*.*sb c%1$dd', 1, 2, 4, 5, r => 19], 'a{_4%2.4s}b c{_1%d}d' , [_4 => 5, _1 => 1, r => 19 ] ); String-Print-0.15/t/11modif.t0000644000175000001440000000333312310534201016376 0ustar00markovusers00000000000000#!/usr/bin/env perl # Serialize variables when sprintid use warnings; use strict; use utf8; use Test::More tests => 16; use String::Print; my $pi = 3.14157; # ## Simple sprintf formatting # my $f = String::Print->new; isa_ok($f, 'String::Print'); my $x1 = $f->sprinti("a={a%d} b={b %.2f}", a => 007, b => $pi); $x1 =~ s/,/./g; # locale may output floats with comma is($x1, "a=7 b=3.14" ); # multi-byte characters my $short = "€éö"; is( $f->sprinti("c={z%s}x", z => $short), "c=${short}x" ); is( $f->sprinti("c2={z %s}x", z => $short), "c2=${short}x" ); is( $f->sprinti("c3={ z%s}x", z => $short), "c3=${short}x" ); is( $f->sprinti("c4={ z %s}x", z => $short), "c4=${short}x" ); is( $f->sprinti("d={z%5s}x", z => $short), "d= ${short}x" ); is( $f->sprinti("e={z%-5s}x", z => $short), "e=${short} x" ); is( $f->sprinti("f={z%5s}x", z => "${short}yzzz"), "f=${short}yzzzx" ); is( $f->sprinti("g={z%.5s}x", z => "${short}yzz"), "g=${short}yzx", 'too large'); is( $f->sprinti("h={z%5.3s}x",z => "${short}yz"), "h= ${short}x" ); is( $f->sprinti("i={z%-5.3s}x",z=> "${short}yz"), "i=${short} x" ); # Now re-run the tests with wide display chars. # XXX # ## Own modifier # sub money($$$$) { my ($formatter, $modif, $value, $args) = @_; # warn "($formatter, $modif, $value, $args)\n"; $modif eq '€' ? sprintf("%.2f EUR", $value) : $modif eq '₤' ? sprintf("%.2f PND", $value/1.23) : 'ERROR'; } my $g = String::Print->new ( modifiers => [ qr/[€₤]/ => \&money ] ); isa_ok($g, 'String::Print'); is( $g->sprinti("a={p€}", p => $pi), "a=3.14 EUR" ); is( $g->sprinti("b={p₤}", p => $pi), "b=2.55 PND" ); is( $g->sprinti("a={p€%10s}", p => $pi), "a= 3.14 EUR", 'stacking modifiers' ); String-Print-0.15/t/30examp_oo.t0000644000175000001440000000233512307353045017124 0ustar00markovusers00000000000000#!/usr/bin/env perl # Demonstrate the OO examples use warnings; use strict; use Test::More tests => 7; use String::Print 'oo'; use POSIX qw/strftime/; # ### currency conversion example # my $f = String::Print->new ( modifiers => [ EUR => sub { sprintf "%5.2f e", $_[2] } ] , serializers => [ UNDEF => sub {'-'} ] ); isa_ok($f, 'String::Print'); is($f->sprinti("price: {p EUR}#", p => 3.1415), 'price: 3.14 e#'); is($f->sprinti("count: {c}#", c => undef), 'count: -#'); # ### date-time conversion # $f->addModifiers( qr/T|DT|D/ => sub { my ($formatter, $modif, $value, $args) = @_; # Windows does not support full POSIX, no %T nor %F my $time_format = $modif eq 'T' ? '%H:%M:%S' : $modif eq 'D' ? '%Y-%m-%d' : $modif eq 'DT' ? '%Y-%m-%dT%H:%M:%SZ' : 'ERROR'; strftime $time_format, gmtime($value); } ); my $now = 1365850757; is($f->sprinti("time: {t T }", t => $now), 'time: 10:59:17', 'time'); is($f->sprinti("date: {t D }", t => $now), 'date: 2013-04-13', 'date'); is($f->sprinti("both: {t DT}", t => $now), 'both: 2013-04-13T10:59:17Z', 'dateTime'); is($f->sprinti("#{t T%10s}#", t => $now), '# 10:59:17#', 'stacked'); String-Print-0.15/META.json0000644000175000001440000000162412310534202016131 0ustar00markovusers00000000000000{ "abstract" : "printf extensions", "author" : [ "Mark Overmeer" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 6.64, CPAN::Meta::Converter version 2.120630", "license" : [ "perl_5" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "String-Print", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "Encode" : "0", "Test::More" : "0.86", "Unicode::GCString" : "0" } } }, "release_status" : "stable", "version" : "0.15" }