App-Kit

 view release on metacpan or  search on metacpan

Changes  view on Meta::CPAN

Revision history for App-Kit

0.63  2020-10-23 11:03:54
    - 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

lib/App/Kit/Obj/FS.pm  view on Meta::CPAN

#     return 2 if !defined $start;
#
#     $self->chdir($start) || return;
#     $self->starting_dir(undef);
#
#     return 1;
# }

sub appdir {
    my ($self) = @_;
    return $self->spec->catdir( $self->bindir(), '.' . $self->_app->str->prefix . '.d' );
}

sub file_lookup {
    my ( $self, @rel_parts ) = @_;

    my $call = ref( $rel_parts[-1] ) ? pop(@rel_parts) : { 'inc' => [] };
    $call->{'inc'} = [] if !exists $call->{'inc'} || ref $call->{'inc'} ne 'ARRAY';

    my @paths;
    for my $base ( @{ $call->{'inc'} }, $self->appdir, @{ $self->inc } ) {

lib/App/Kit/Obj/FS.pm  view on Meta::CPAN

has spec => (
    'is'      => 'ro',
    'lazy'    => '1',
    'default' => sub {
        require File::Spec;
        return 'File::Spec';
    },
);

has bindir => (
    'is'   => 'rw',
    'lazy' => '1',

    # 'isa'     => sub { die "'bindir' must be a directory" unless -d $_[1] },
    'default' => sub {

        # PSGI/Plack $0
        #   1. starman worker -Ilib … t/test.psgi
        #   2. 500 error: Cannot find current script 'starman worker -Ilib … t/test.psgi' at …/FindBin.pm line 166.
        local $0 = $0;
        if ( $0 =~ m/(\S+\.psgi)/ ) {
            $0 = $1;
        }
        require FindBin;

lib/App/Kit/Obj/FS.pm  view on Meta::CPAN

Takes one required attribute: _app. It should be an L<App::Kit> object for it to use internally.

Has 3 optional attributes:

=head3 spec

Lazy loads L<File::Spec> and returns the class accessor for L<File::Spec> methods. Setting this via new() is probably not a good idea.

    my $dir = $fs->spec->catdir(…);

=head3 bindir

The applications main directory. Defaults to script’s directory or the current working directory.

Lazy loads L<FindBin> and L<Cwd>.

Works with .psgi files being run under Plack/PSGI.

=head3 inc

An array ref of paths for file_lookup() to use. Defaults to [].

lib/App/Kit/Obj/FS.pm  view on Meta::CPAN

=head2 cwd()

Lazy wrapper of L<Cwd>’s cwd().

=head2 appdir()

The directory that belongs to the app.

It is a directory in the object’s base path called .$prefix.d (where $prefix is the _app attributes’s ->str->prefix):

$fs->bindir()/.$str->prefix().d/

=head2 file_lookup()

In scalar context returns the first path that exists for the given arguments.

In array context returns all possible paths for the given arguments without any existence check.

The final argument can be a config hashref with the inc key whose value is an array of paths.

The arguments are the pieces of the path you are interested in that get put together in a portable way.

    my $conf = $fs->file_lookup('data', 'foo.json'); # e.g. …/my_app_bindir/.appkit.d/data/foo.json

The path is looked for in this order:

=over 4

1. the 'inc' paths in the given argument if any

2. appdir()

3. the objects’s inc attribute

t/07.fs-psgi.t  view on Meta::CPAN

use Test::More;

use App::Kit;

my $app = App::Kit->new();

my $cwd   = $app->fs->cwd;
my $tdir  = $app->fs->tmpdir;
my $fsdir = $tdir->{'REALNAME'};    # necessary here to string-match bindir’s Cwd calls/logic results

chdir $fsdir || die "Could not go chdir to tmp dir: $!";
mkdir 'foo'  || die "Could not mkdir foo: $!";
my $foodir = $app->fs->spec->catdir( "$fsdir", 'foo' );
my $fsfile = $app->fs->spec->catfile( $foodir, 'test.psgi' );
$app->fs->write_file( $fsfile, "sub {}" );

{
    local $0 = 'starman worker -Ilib … foo/test.psgi';
    is $app->fs->bindir, $foodir, 'bindir w/ PSGI/Plack $0';
    is( $0, 'starman worker -Ilib … foo/test.psgi', '$0 not changed by bindir()' );
}

chdir $cwd || die "Could not go back to starting dir: $!";

done_testing;

t/07.fs.t  view on Meta::CPAN

ok( !exists $INC{'Cwd.pm'}, 'Sanity: Cwd not loaded before cwd()' );
is( $app->fs->cwd, Cwd::cwd(), 'cwd() meth returns same Cwd::cwd' );    # since the method loads the module the second arg works without an explicit use statement
ok( exists $INC{'Cwd.pm'}, 'Cwd lazy loaded on initial cwd()' );

# $app->fs->spec
Class::Unload->unload('File::Spec');                                    # Class::Unload brings File::Spec in
ok( !exists $INC{'File/Spec.pm'}, 'Sanity: File::Spec not loaded before spec()' );
is( $app->fs->spec, 'File::Spec', 'spec returns class name for method calls' );
ok( exists $INC{'File/Spec.pm'}, 'File::Spec lazy loaded on initial spec()' );

# $app->fs->bindir
Class::Unload->unload('FindBin');
ok( !exists $INC{'FindBin.pm'}, 'Sanity: Findbin not loaded before bindir()' );
is( $app->fs->bindir, $FindBin::Bin, 'bindir() returns $Findbin::Bin first' );
ok( exists $INC{'FindBin.pm'}, 'Findbin lazy loaded on initial bindir()' );
{
    local $FindBin::Bin = undef;
    no warnings 'redefine';
    local *FindBin::again = sub { return "foo" };

    delete $app->fs->{bindir};
    is( $app->fs->bindir, 'foo', 'bindir() returns FindBin->again second' );

    *FindBin::again = sub { return };
    delete $app->fs->{bindir};
    is( $app->fs->bindir, $app->fs->cwd, 'bindir() returns cwd third' );
}
is( $app->fs->bindir("mybin"), 'mybin', 'bindir() sets and returns manually set value' );
is( $app->fs->bindir,          'mybin', 'bindir() returns manually set value' );

# $app->fs->tmpdir
ok( !exists $INC{'File/Temp.pm'}, 'Sanity: File::Temp not loaded before tmpdir()' );
my $dir = $app->fs->tmpdir;
ok( -d $dir,                     'tmpdir() returns file name' );
ok( exists $INC{'File/Temp.pm'}, 'File::Temp lazy loaded on initial tmpdir()' );

# $app->fs->tmpfile
Class::Unload->unload('File::Temp');
ok( !exists $INC{'File/Temp.pm'}, 'Sanity: File::Temp not loaded before tmpfile()' );

t/07.fs.t  view on Meta::CPAN

#### File::Copy::Recursive ##
#############################

# TODO use (forth coming AOTW) modern version

#################################
#### TODO: $app->fs->file_lookup ## Sprtin tailstails
#################################

my $tmp = $app->fs->tmpdir;
$app->fs->bindir($tmp);
my $main_dir = $app->fs->spec->catdir( $tmp, '.appkit.d' );

is_deeply( [ $app->fs->file_lookup ], [$main_dir], 'file_lookup(): no args gives inc dirs' );
is_deeply( [ $app->fs->file_lookup('fiddle.conf') ], [ $app->fs->spec->catfile( $main_dir, 'fiddle.conf' ) ], 'file_lookup(): one arg is file name' );
is_deeply( [ $app->fs->file_lookup( 'config', 'fiddle.conf' ) ], [ $app->fs->spec->catfile( $main_dir, 'config', 'fiddle.conf' ) ], 'file_lookup(): multi arg is paths parts' );

# { inc => […], }
is_deeply( [ $app->fs->file_lookup( { inc => [ 'myhack', 'yourhack' ], } ) ], [ 'myhack', 'yourhack', $main_dir ], 'file_lookup(): inc hash, no args gives inc dirs' );
is_deeply(
    [ $app->fs->file_lookup( 'fiddle.conf', { inc => [ 'myhack', 'yourhack' ], } ) ],

t/07.fs.t  view on Meta::CPAN

$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;
$app->str->prefix("yabba");
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' );

t/09.db.t  view on Meta::CPAN

    @e = ( 'DBI:foo:database=mydb;host=localhost;dsn=99;foo=78', '', '', undef );
    $n = 'dsn_attr';
    $app->db->dbh( { dbd_driver => "foo", database => "mydb", dsn_attr => { dsn => 99, foo => 78 } } );
}

#########################
## tests via conf file ##
#########################

$app->fs->bindir($dir);
my $sqlite_f = $app->fs->spec->catdir( $dir, 'conf_db' );
my $conf_file = $app->fs->spec->catdir( $dir, '.appkit.d', 'config', 'db.yaml' );
$app->fs->mk_parent($conf_file);
$app->fs->yaml_write( $conf_file, { dbd_driver => 'SQLite', database => $sqlite_f } );

$app->db->disconn;
is( $app->db->_dbh, undef, 'sanity main DBH not set' );
isa_ok( $app->db->dbh(), 'DBI::db', 'dbh() connected via conf file data' );
is( $app->db->dbh()->{Driver}{Name}, 'SQLite', 'connected conf is correct driver' );

t/pod-spelling.t  view on Meta::CPAN

'rwp'
ENV
refactor
ick
multiton
readonly
readwrite

'inc'
bindir

'database'
'host'
'pass'
'user'
DSN
SQLite
datetime
dbh
utf