App-Kit
view release on metacpan or search on metacpan
- add str->epoch, str->attrs, str->escape_html
- fix tets for prl 5.32
0.62 2013-12-17 05:15:32
- rt 91462: remove dep that caused circular dep
- add _force_new option to db->dbh
0.61 2013-12-15 10 11:38:09
- minimum version of YAML::Syck for consistent non-escaping of utf8
- remove current escaped utf8 handling since its built into YAML::Syck now
- add YAML and JSON tests for handling of unicode strings
- correct NS in NAME section of A::K::O::DB
- update required ver of String::UnicodeUTF8 to latest Unicode zero padding \x{} version
- update required version of Devel::Kit to latest (so that other reqs match)
0.6 2013-11-10 10 18:53:06
- Add ex() role
- Move RW and RunCom to Util/
0.5 2013-11-09 12:18:17
- read/write JSON and YAML
lib/App/Kit/Obj/Str.pm view on Meta::CPAN
# regex is made from the Unicode code points from: `uninames invisible`
my $invisible = qr/(?:\xe2\x80\x8b|\xe2\x81\xa2|\xe2\x81\xa3|\xe2\x81\xa4)/;
# regex is made from the Unicode code points from: `unichars '\p{Control}'`
my $control =
qr/(?:\x00|\x01|\x02|\x03|\x04|\x05|\x06|\x07|\x08|\x09|\x0a|\x0b|\x0c|\x0d|\x0e|\x0f|\x10|\x11|\x12|\x13|\x14|\x15|\x16|\x17|\x18|\x19|\x1a|\x1b|\x1c|\x1d|\x1e|\x1f|\x7f|\xc2\x80|\xc2\x81|\xc2\x82|\xc2\x83|\xc2\x84|\xc2\x85|\xc2\x86|\xc2\x87|\...
return sub {
my ( $str, $string, $collapse ) = @_;
my $is_unicode = String::UnicodeUTF8::is_unicode($string);
$string = String::UnicodeUTF8::get_utf8($string);
$string =~ s/(?:$disallowed_whitespace|$invisible|$control)+//g;
$string =~ s/^(?:\x20|\xc2\xa0)+//;
$string =~ s/(?:\x20|\xc2\xa0)+$//;
$string =~ s/(?:\x20|\xc2\xa0){2,}/ /g if $collapse;
return $is_unicode ? String::UnicodeUTF8::get_unicode($string) : $string;
};
};
sub epoch {
return time;
}
sub attrs {
my ( $str, $attr_hr, $ignore ) = @_;
return '' if !keys %{$attr_hr};
lib/App/Kit/Obj/Str.pm view on Meta::CPAN
Lazy wrapper of L<JSON::Syck>’s Dump().
=head2 ref_to_jsonp()
Like ref_to_json() but pads it. The function name defaults to “jsonp_callback†but can be given as a second argument.
return()’s if you give it a function name with anything besides [0-9a-zA-Z_].
=head2 trim()
Takes a string (unicode or utf8 bytes)
and returns a version of it with all unicode whitespace (except space and non-break-space), invisible, and control characters removed and also leading and trailing space/non-break-space removed
A second boolean argument (default false) will collapse multiple space/non-break-space sequences down to a single space.
=head2 sha512()
Lazy wrapper of L<Digest::SHA>’s sha512_hex().
=head2 epoch()
Takes no arguments, returns the current epoch.
"utf8": 'I ♥ Perl'
};
my $json_cont = q();
#### YAML ##
is( $app->str->ref_to_yaml($my_data), $yaml_cont, 'structure turns into expected YAML' );
is_deeply( $app->str->yaml_to_ref($yaml_cont), $my_data, 'YAML turns into expected structure' );
is( $app->str->ref_to_yaml( { 'unistr' => "I \x{2665} Unicode" } ), qq{--- \n"unistr": 'I \xe2\x99\xa5 Unicode'\n}, 'structure (w/ unicode str) turns into expected YAML' );
#### JSON ##
like( $app->str->ref_to_json($my_data), qr/"utf8"\s*:\s*"I \xe2\x99\xa5 Perl"/, 'structure turns into expected JSON' );
is_deeply( $app->str->json_to_ref(qq({"foo":42})), { foo => 42 }, 'JSON turns into expected structure' );
like( $app->str->ref_to_json( { 'unistr' => "I \x{2665} Unicode" } ), qr/"unistr"\s*:\s*"I \xe2\x99\xa5 Unicode"/, 'structure (w/ unicode str) turns into expected JSON' );
is( $app->str->ref_to_jsonp($my_data), 'jsonp_callback(' . $app->str->ref_to_json($my_data) . ');', 'JSONP w/ no callback arg' );
is( $app->str->ref_to_jsonp( $my_data, 'scotch' ), 'scotch(' . $app->str->ref_to_json($my_data) . ');', 'JSONP w/ callback arg' );
is( $app->str->ref_to_jsonp( $my_data, 'mord mord' ), undef, 'JSONP w/ invalid callback arg' );
#### trim() ##
my @strings = (
[ "foo", "foo", "foo", "none" ],
[ " f oo ", "f oo", "f oo", "basic" ],
[ " f \xe2\x99\xa5oo ", "f \xe2\x99\xa5oo", "f \xe2\x99\xa5oo", "basic bytes" ],
[ " f \x{2665}oo ", "f \x{2665}oo", "f \x{2665}oo", "basic unicode" ],
[ "\xc2\xa0foo\xc2\xa0\xc2\xa0bar\xc2\xa0", "foo\xc2\xa0\xc2\xa0bar", "foo bar", "nbsp" ],
[ "f\x00oo \xc2\xa0b\xe2\x80\x8ba\x09r", "foo \xc2\xa0bar", "foo bar", "funky chunks-bytes" ],
[ "f\x{0000}oo \x{00a0}b\x{200b}a\x{0009}r", "foo \x{00a0}bar", "foo bar", "funky chunks-unicode" ],
);
for my $str (@strings) {
is $app->str->trim( $str->[0] ), $str->[1], "trim($str->[3])";
is $app->str->trim( $str->[0], 1 ), $str->[2], "trim($str->[3],1)";
}
### sha512 ###
is( $app->str->sha512(42), '39ca7ce9ecc69f696bf7d20bb23dd1521b641f806cc7a6b724aaa6cdbffb3a023ff98ae73225156b2c6c9ceddbfc16f5453e8fa49fc10e5d96a3885546a46ef4', 'sha512 number' );
my $data = $app->fs->yaml_read($yaml_file);
is_deeply( $data, $my_data, 'yaml_read loads expected data' );
ok( $app->fs->yaml_write( $yaml_file, $data ), 'yaml_write returns true on success again' );
is( $app->fs->read_file($yaml_file), $yaml_cont, 'yaml_write had expected content written' );
$data = $app->fs->yaml_read($yaml_file);
is_deeply( $data, $my_data, 'yaml_read loads expected data again' );
$app->fs->yaml_write( $yaml_file, { 'unistr' => "I \x{2665} Unicode" } );
is( $app->fs->read_file($yaml_file), qq{--- \n"unistr": 'I ♥ Unicode'\n}, 'yaml_write does unicode string as bytes (i.e. a utf8 string)' );
$data = $app->fs->yaml_read($yaml_file);
is_deeply( $data, { 'unistr' => "I \xe2\x99\xa5 Unicode" }, 'yaml_read reads previously unicode string written as bytes string as bytes' );
dies_ok { $app->fs->yaml_write($hack_dir) } 'yaml_write dies on failure';
dies_ok { $app->fs->yaml_read( $$ . 'asfvadfvdfva' . time ) } 'yaml_read dies on failure';
#### JSON ##
ok( $app->fs->json_write( $json_file, $my_data ), 'json_write returns true on success' );
like( $app->fs->read_file($json_file), qr/"utf8": "I \xe2\x99\xa5 Perl"/, 'json_write had expected content written' ); # string can change, no way to SortKeys like w/ YAML::Syck, so just make sure utf8 not written in escape syntax
$data = $app->fs->json_read($json_file);
is_deeply( $data, $my_data, 'json_read loads expected data' );
ok( $app->fs->json_write( $json_file, $data ), 'json_write returns true on success again' );
like( $app->fs->read_file($json_file), qr/"utf8": "I ♥ Perl"/, 'json_write had expected content written' ); # string can change, no way to SortKeys like w/ YAML::Syck, so just make sure utf8 not written in escape syntax
$data = $app->fs->json_read($json_file);
is_deeply( $data, $my_data, 'json_read loads expected data again' );
$app->fs->json_write( $json_file, { 'unistr' => "I \x{2665} Unicode" } );
is( $app->fs->read_file($json_file), '{"unistr": "I ♥ Unicode"}' . "\n", 'json_write does unicode string as bytes (i.e. a utf8 string)' );
$data = $app->fs->json_read($json_file);
is_deeply( $data, { 'unistr' => "I \xe2\x99\xa5 Unicode" }, 'json_read reads previsouly unicode string written as bytes string as bytes' );
dies_ok { $app->fs->json_write($hack_dir) } 'json_write dies on failure';
dies_ok { $app->fs->json_read( $$ . 'asfvadfvdfva' . time ) } 'json_read dies on failure';
################
#### appdir() ##
################
is( $app->fs->appdir, $app->fs->spec->catdir( $app->fs->bindir(), '.' . $app->str->prefix() . '.d' ), 'appdir() returns expected string' );
my $curprfx = $app->str->prefix;
is( $app->fs->appdir, $app->fs->spec->catdir( $app->fs->bindir(), '.yabba.d' ), 'appdir() returns expected string each time (e.g. when prefix changes)' );
$app->str->prefix($curprfx);
#####################################
#### is_safe_part() is_safe_path() ##
#####################################
is_deeply( [ $app->fs->is_safe_part() ], [], 'is_safe_part no arg' );
is_deeply( [ $app->fs->is_safe_part(undef) ], [], 'is_safe_part undef' );
is_deeply( [ $app->fs->is_safe_part('') ], [], 'is_safe_part no empty' );
is_deeply( [ $app->fs->is_safe_part("\x{2665}") ], [], 'is_safe_part no unicode' );
is_deeply( [ $app->fs->is_safe_part("foo/bar") ], [], 'is_safe_part path' );
is_deeply( [ $app->fs->is_safe_path() ], [], 'is_safe_path no arg' );
is_deeply( [ $app->fs->is_safe_path(undef) ], [], 'is_safe_path undef' );
is_deeply( [ $app->fs->is_safe_path('') ], [], 'is_safe_path no empty' );
is_deeply( [ $app->fs->is_safe_path("\x{2665}/foo") ], [], 'is_safe_path no unicode' );
is_deeply( [ $app->fs->is_safe_path('/foo/bar') ], [], 'is_safe_path abs' );
is_deeply( [ $app->fs->is_safe_path("foo/bar/") ], [], 'is_safe_path trailing' );
is_deeply( [ $app->fs->is_safe_path('/foo/bar/') ], [], 'is_safe_path abs and trailing' );
is( $app->fs->is_safe_path( '/foo/bar', 1 ), 1, 'is_safe_path abs ok' );
is( $app->fs->is_safe_path( "foo/bar/", 0, 1 ), 1, 'is_safe_path trailing ok' );
is( $app->fs->is_safe_path( "/foo/bar/", 1, 1 ), 1, 'is_safe_path abd and trailing ok' );
ok( $app->fs->is_safe_part("foo"), "is_safe_part() path part OK" );
( run in 0.343 second using v1.01-cache-2.11-cpan-88abd93f124 )