File Coverage

lib/Asset/Pack.pm

Criterion	Covered	Total	%
statement	115	123	93.5
branch	24	34	70.5
condition	5	8	62.5
subroutine	21	22	95.4
pod	3	3	100.0
total	168	190	88.4

use 5.006;    # our
use strict;
use warnings;

package Asset::Pack;

use Path::Tiny 0.069 qw( path );    # path()->visit without broken ref returns
use Try::Tiny qw( try catch );

our $VERSION = '0.000002';

# ABSTRACT: Easily pack assets into Perl Modules that can be fat-packed

our $AUTHORITY = 'cpan:KENTNL'; # AUTHORITY

use parent qw(Exporter);
our @EXPORT_OK = qw();
our @EXPORT    = qw(write_module write_index find_and_pack);

#pod =func C
#pod
#pod   # write_module( $source, $module, $libdir?, $metadata? );
#pod
#pod   write_module( "./foo.js", "Foo::Bar", "./" );
#pod
#pod   # ./Foo/Bar.pm now contains a uuencoded copy of foo.js
#pod
#pod Given a source asset path, a module name and a library directory, packs the
#pod source into a module named C<$module> and saves it in the right place relative
#pod to C<$libdir>
#pod
#pod Later, getting the file is simple:
#pod
#pod   use Foo::Bar;
#pod   print $Foo::Bar::content;    # File Content is a string.
#pod
#pod =head3 options:
#pod
#pod =over 4
#pod
#pod =item C<$source> - A path describing where the asset is found
#pod
#pod =item C<$module> - A target name for the generated module
#pod
#pod =item C<$libdir> B<[optional]> - A target directory to serve as a base for modules.
#pod
#pod Defaults to C<./lib>.
#pod
#pod =item C<$metadata> B<[optional]> - A C payload of additional data to store in the module.
#pod
#pod =back
#pod
#pod =cut

sub write_module {
  my ( $source, $module, $libdir, $metadata ) = @_;
  my $dest = _module_full_path( $module, $libdir );
  $dest->parent->mkpath;    # mkdir
  $dest->spew_utf8( _pack_asset( $module, $source, $metadata ) );
  return;
}

#pod =func C
#pod
#pod   # write_index( $index, $module, $libdir?, $metadata? );
#pod
#pod   write_index( { "A" => "X.js" }, "Foo::Bar", "./" );
#pod
#pod Creates a file index. This allows creation of a map of:
#pod
#pod   "Module::Name" => "/Source/Path"
#pod
#pod Entries that will be available in a constructed module as follows:
#pod
#pod   use Module::Name;
#pod   $Module::Name::index->{"Module::Name"}    # A String Path
#pod
#pod These generated files do B have a C<__DATA__> section
#pod
#pod =head3 options:
#pod
#pod =over 4
#pod
#pod =item C<$source> - A path describing where the asset is found
#pod
#pod =item C<$module> - A target name for the generated module
#pod
#pod =item C<$libdir> B<[optional]> - A target directory to serve as a base for modules.
#pod
#pod Defaults to C<./lib>.
#pod
#pod =item C<$metadata> B<[optional]> - A C payload of additional data to store in the module.
#pod
#pod =back
#pod
#pod =cut

sub write_index {
  my ( $index, $module, $libdir, $metadata ) = @_;
  my $dest = _module_full_path( $module, $libdir );
  $dest->parent->mkpath;
  $dest->spew_utf8( _pack_index( $module, $index, $metadata ) );
  return;
}

#pod =func C
#pod
#pod   # find_and_pack( $root_dir, $namespace_prefix, $libdir? ) -> Hash
#pod
#pod Creates copies of all the contents of C<$root_dir> and constructs
#pod ( or reconstructs ) the relevant modules using C<$namespace_prefix>
#pod and stores them in C<$libdir> ( which defaults to C<./lib/> )
#pod
#pod B:
#pod Also generates an "index" file ( See L<< C|/write_index >> ) at the name C<$namespace_prefix>.
#pod
#pod Returns a hash detailing operations and results:
#pod
#pod   {
#pod     ok        => [ { module => ..., file => ... }, ... ],
#pod     unchanged => [ { module => ..., file => ... }, ... ],
#pod     fail      => [ { module => ..., file => ..., error => ... }, ... ],
#pod   }
#pod
#pod Index updates will be in above list except with C<< index => 1 >> instead of C<< file => >>
#pod
#pod =head3 options:
#pod
#pod =over 4
#pod
#pod =item C<$root_dir> - The base path where the assets to be packed are stored
#pod
#pod =item C<$namespace_prefix> - A module name like C which will be used as the parent for generated modules.
#pod
#pod =item C<$libdir> B<[optional]> - The target directory to generate the Modules in.
#pod
#pod Defaults to C<./lib>.
#pod
#pod =back
#pod
#pod =cut

sub find_and_pack {
  my ( $dir, $ns, $libdir ) = @_;
  my %assets = _find_assets( $dir, $ns );
  my ( @ok, @fail, @unchanged );
  while ( my ( $module, $file ) = each %assets ) {
    my $m         = path( _module_full_path( $module, $libdir ) );
    my $file_path = path($file)->absolute($dir);                     # Unconvert from relative.
    my $fd        = try { $file_path->stat->mtime } catch { 0 };
    my $md        = try { $m->stat->mtime } catch { 0 };
    if ( $md > 0 and $fd <= $md ) {
      push @unchanged, { module => $module, module_path => $m, file => "$file", file_path => $file_path };
      next;
    }
    try {
      write_module( $file_path, $module, $libdir );
      push @ok, { module => $module, module_path => $m, file => "$file", file_path => $file_path };
    }
    catch {
      push @fail, { module => $module, module_path => $m, file => "$file", file_path => $file_path, error => $_ };
    };
  }
  my $index_path = path( _module_full_path( $ns, $libdir ) );
  my $index_return = { module => $ns, module_path => $index_path, index => 1 };

  if (@fail) {

    # Any fails -> No Attempt
    $index_return->{error} = 'A module failed prior to index generation';
    push @fail, $index_return;
  }
  elsif ( not @ok and not -e $index_path ) {

    # No "ok" results only generate index if one does not exist.
    write_index( \%assets, $ns, $libdir, );
    push @ok, $index_return;
  }
  elsif (@ok) {

    # Any ok results generate index.
    write_index( \%assets, $ns, $libdir, );
    push @ok, $index_return;
  }
  else {
    push @unchanged, $index_return;
  }
  return { ok => \@ok, fail => \@fail, unchanged => \@unchanged };
}

sub _modulify {
  my ( $path, $namespace ) = @_;
  $path =~ s/[^[:lower:]]//gi;
  return $namespace . q[::] . $path;
}

sub _module_rel_path {
  my ($module) = @_;
  $module =~ s{::}{/}g;
  return "${module}.pm";
}

sub _module_full_path {
  my ( $module, $libdir ) = @_;
  $libdir = './lib' if not defined $libdir;
  return path($libdir)->child( _module_rel_path($module) );
}

sub _pack_asset {
  my ( $module, $path, $metadata ) = @_;
  my $content = pack 'u', path($path)->slurp_raw;
  my $metadata_header = _pack_metadata($metadata);

  return <<"EOF";
use strict;
use warnings;
package $module;
$metadata_header
our \$content = do { local \$/;  };
close *DATA;
\$content =~ s/\\s+//g;
\$content = unpack 'u', \$content;
1;
__DATA__