App-Kit
view release on metacpan or search on metacpan
- adjust warning test regex to match better (e.g. d5b5d78a-6752-11e3-ace4-6da5dfbfc7aa)
- change arbitrary module name in test to avoid "CGI will be removed from the Perl core distribution in the next major release. Please install it from CPAN." breaking TAP (d7e824b8-6752-11e3-ace4-6da5dfbfc7aa)
- attempt more universal failure in test (e.g. 75564f20-675a-11e3-bd14-e3bee4621ba3)
- make fs->bindir() work w/ PSGI/Plack $0
- add str->rand
- add fs->appdir
- add JSON and YAML methods to str()
- add fs->is_safe_part and fs->is_safe_path
- add str->trim
- add str->sha512
- 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
lib/App/Kit/Obj/FS.pm view on Meta::CPAN
local $YAML::Syck::ImplicitTyping = 0;
local $YAML::Syck::SingleQuote = 1; # to keep from arbitrary quoting/unquoting (to help make diff's cleaner)
local $YAML::Syck::SortKeys = 1; # to make diff's cleaner
return YAML::Syck::DumpFile( $file, $ref ); # this does not keep the same $YAML::Syck:: vars apparently: shift;goto &YAML::Syck::DumpFile;
# as of at least v1.27 it writes the characters without \x escaping so no need for:
# return $self->write_file(
# $file,
# String::UnicodeUTF8::unescape_utf8( YAML::Syck::Dump($ref) )
# );
};
};
Sub::Defer::defer_sub __PACKAGE__ . '::yaml_read' => sub {
require YAML::Syck;
return sub {
my ( $self, $file ) = @_;
local $YAML::Syck::ImplicitTyping = 0;
return YAML::Syck::LoadFile($file); # this does not keep the same $YAML::Syck:: vars apparently: shift;goto &YAML::Syck::LoadFile;
};
};
Sub::Defer::defer_sub __PACKAGE__ . '::json_write' => sub {
require JSON::Syck;
return sub {
shift;
goto &JSON::Syck::DumpFile; # already does ♥ instead of \xe2\x99\xa5 (i.e. so no need for String::UnicodeUTF8::unescape_utf8() like w/ the YAML above)
};
};
Sub::Defer::defer_sub __PACKAGE__ . '::json_read' => sub {
require JSON::Syck;
return sub {
shift;
goto &JSON::Syck::LoadFile;
};
};
lib/App/Kit/Obj/Str.pm view on Meta::CPAN
};
};
Sub::Defer::defer_sub __PACKAGE__ . '::yaml_to_ref' => sub {
require YAML::Syck;
return sub {
my ( $self, $yaml ) = @_;
# See fs->yaml_read
local $YAML::Syck::ImplicitTyping = 0;
return YAML::Syck::Load($yaml); # already does ♥ instead of \xe2\x99\xa5 (i.e. so no need for String::UnicodeUTF8::unescape_utf8() like w/ the YAML above)
};
};
Sub::Defer::defer_sub __PACKAGE__ . '::ref_to_yaml' => sub {
require YAML::Syck;
return sub {
my ( $self, $ref ) = @_;
# See fs->yaml_write
local $YAML::Syck::ImplicitTyping = 0;
local $YAML::Syck::SingleQuote = 1; # to keep from arbitrary quoting/unquoting (to help make diff's cleaner)
local $YAML::Syck::SortKeys = 1; # to make diff's cleaner
return YAML::Syck::Dump($ref); # as of at least v1.27 it writes the characters without \x escaping so no need to String::UnicodeUTF8::unescape_utf8 the result
};
};
Sub::Defer::defer_sub __PACKAGE__ . '::json_to_ref' => sub {
require JSON::Syck;
return sub {
shift;
goto &JSON::Syck::Load; # already does ♥ instead of \xe2\x99\xa5 (i.e. so no need for String::UnicodeUTF8::unescape_utf8() like w/ the YAML above)
};
};
Sub::Defer::defer_sub __PACKAGE__ . '::ref_to_json' => sub {
require JSON::Syck;
return sub {
shift;
goto &JSON::Syck::Dump; # already does ♥ instead of \xe2\x99\xa5 (i.e. so no need for String::UnicodeUTF8::unescape_utf8() like w/ the YAML above)
};
};
sub ref_to_jsonp {
my ( $app, $ref, $function ) = @_;
$function ||= 'jsonp_callback';
return if $function =~ m/[^0-9a-zA-Z_]/;
return $function . '(' . $app->ref_to_json($ref) . ');';
}
lib/App/Kit/Obj/Str.pm view on Meta::CPAN
sub epoch {
return time;
}
sub attrs {
my ( $str, $attr_hr, $ignore ) = @_;
return '' if !keys %{$attr_hr};
return ' ' . join(
' ',
map { exists $ignore->{$_} ? () : !defined $attr_hr->{$_} ? $_ : $_ . '="' . $str->escape_html( $attr_hr->{$_} ) . '"' }
keys %{$attr_hr}
);
}
Sub::Defer::defer_sub __PACKAGE__ . '::escape_html' => sub {
require HTML::Escape;
return sub {
shift;
goto &HTML::Escape::escape_html;
};
};
1;
__END__
=encoding utf-8
=head1 NAME
lib/App/Kit/Obj/Str.pm view on Meta::CPAN
Lazy wrapper of L<Digest::SHA>’s sha512_hex().
=head2 epoch()
Takes no arguments, returns the current epoch.
=head2 attrs()
Take a hashref of attributes to stringify. There will be a leading space (to avoid extra space in output/logic in template use).
If the value is undef then only the name is output (e.g. for HTML5-osh boolean attributes). The values are HTML escaped.
If order matters build them from multiple calls in the order you want.
$str->attrs({class=>"foo bar", required=>undef}) # ' class="foo bar" required'
Takes a second optional argument that is a lookup hashref of attributes to ignore.
$str->attrs({class=>"foo bar", required=>undef}, {class=>1}) # ' required'
=head2 escape_html()
Lazy wrapper of L<HTML::Escape>’s escape_html().
=head1 DIAGNOSTICS
Setting the prefix to an invalid value can result in an error that is descriptive of the problem.
=head1 CONFIGURATION AND ENVIRONMENT
Requires no configuration files or environment variables.
=head1 DEPENDENCIES
my $time = time;
my $epoch = $app->str->epoch;
cmp_ok( $epoch, '>=', $time, 'epoch() works like time' ); # if this fails due to a race your clock is busted
#### attrs ##
my $attrs = $app->str->attrs( { title => "hello & world", class => "foo bar" } );
like( $attrs, qr/^ \S/, 'attrs begines witha space' );
like( $attrs, qr/ class="foo bar"/, 'basic attr formatted as expected' );
like( $attrs, qr/ title="hello & world"/, 'attr values with HTML escaped' );
$attrs = $app->str->attrs( { title => "hello & world", class => "foo bar", required => undef, barf => "" } );
like( $attrs, qr/^ \S/, 'attrs begines witha space' );
like( $attrs, qr/ class="foo bar"/, 'basic attr formatted as expected 2' );
like( $attrs, qr/ title="hello & world"/, 'attr values with HTML escaped 2' );
like( $attrs, qr/ barf=""/, 'attr empty formatted as expected (empty value)' );
like( $attrs, qr/ required(?!=)/, 'attr undef formatted as boolean (no value)' );
$attrs = $app->str->attrs( { title => "hello & world", class => "foo bar", required => undef, barf => "" }, { barf => 1, required => 1, title => 1 } );
like( $attrs, qr/^ \S/, 'attrs begines witha space' );
like( $attrs, qr/ class="foo bar"/, 'basic attr formatted as expected 3' );
unlike( $attrs, qr/ title="hello & world"/, 'attr ignored (value)' );
unlike( $attrs, qr/ barf=""/, 'attr ignored (empty)' );
unlike( $attrs, qr/ required/, 'attr ignored (undef)' );
#### escape_html ##
is( $app->str->escape_html(qq{<b>hack's®</b>The "planet's'" `peril` ©}), '<b>hack's&reg</b>The "planet's'" `peril` &copy;', q{escape_html() does multiple <>"'`& characters} );
done_testing;
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';
( run in 0.749 second using v1.01-cache-2.11-cpan-c21f80fb71c )