App-CatalystStarter-Bloated

 view release on metacpan or  search on metacpan

lib/App/CatalystStarter/Bloated/Initializr.pm  view on Meta::CPAN

package # hide from pause
    App::CatalystStarter::Bloated::Initializr;

use warnings;
use strict;
use Carp;

use version; our $VERSION = qv('0.9.3');

use File::ShareDir qw/module_file/;
use Archive::Zip;
use File::Basename;
use Mojo::DOM;
use Log::Log4perl qw/:easy/;

my $az;
my $logger = get_logger;
## nice to have this in top
sub l{
    $logger
}
sub _require_az {
    confess "az object not initialized" unless defined $az and $az->isa("Archive::Zip");
}
sub _set_logger {
    $logger = shift;
}

## Top level functions
sub deploy {

    _initialize();

    _require_az;

    my $dir = shift;

    _setup_index();
    _move_images();
    _move_css_js_fonts();

    $az->extractTree( "initializr", $dir );
    l->info( "HTML5: template unzipped to catalyst root" );

}
sub _initialize_from_cache {
    l->debug("Getting template from cache");
    _set_az_from_cache();
}
sub _initalize_over_http {
    l->debug("Getting template from initializr.com" );
}
sub _initialize {
    _initialize_from_cache;
    l->debug("HTML5: Template loaded");
}

## High level functions:


## parse index.html:
## 1) substitute content for [% content %]
## 2) store it again with new name wrapper.tt2
##    - index.html should not be in zip afterwards
## 3) fix any local links to img, css or js, should point to:
## 4) /static/images, css and js
sub _setup_index {

    _require_az;

    my $dom = _index_dom();

    ## insert content template var
    {
        my $div = $dom->find( 'body > div[class="container"]' )->first;
        if ( !$div ) {
            croak "container tag not found in html template - cannot continue";
        }
        $div->content( "[% content %]" );
        l->debug( "HTML5: Wrapper content template var inserted" );
    }

    ## insert jumbotron, might aswell since the template has it
    {
        my $div = $dom->find
            ( 'body > div[class="jumbotron"] > div[class="container"]' )->first;
        if ( !$div ) {
            croak "container tag not found in html template - cannot continue";
        }

        my $p = $div->parent;

        $p->prepend( "\n[% IF jumbotron %]" .
                         "[% # put a h1 and one or more p in here %]\n    "
                     );

        my $h1 = $div->find( 'h1' )->first;
        $h1->content( '[% jumbotron.header %]' );
        my $ps = $div->find( 'p' );

        my $pa = $ps->first;

        $pa->content( '[% jumbotron.body %]' );

        my $i;
        $div->children->each
            ( sub {

                  if ( ++$i > 2 ) {
                      $_[0]->remove;
                  }

              });



        $p->append( "\n[% END %]\n" );
        l->debug( "HTML5: Wrapper jumbotron template var inserted" );
    }

    ## fix any relative links to img/ or css/ or js/ to now point to static/
    $dom->find("*")->each(
        sub {
            my($element,$i) = @_;

            my %h = %$element;

            while ( my($key,$val) = each %h ) {

                # print "# '$key'='$val' ";

                if ( $val =~ m{(?:\./)?img/} ) {
                    (my $new_val = $val) =~
                        s{(?:\./)?img/(.*)}{[% c.uri_for(QUOTEHERE/static/images/$1QUOTEHERE) %]};
                    $element->attr($key => $new_val);
                    # print "=> '$new_val'";
                }
                elsif ( $val =~ m{(?:\./)?(css|js)/} ) {
                    my $d = $1;
                    (my $new_val = $val) =~
                        s{(?:\./)?$d/(.*)}{[% c.uri_for(QUOTEHERE/static/$d/$1QUOTEHERE) %]};
                    $element->attr($key => $new_val);
                    # print "=> '$new_val'";
                }

                # print "\n";

            }

        });
    l->debug("HTML5: references to img/ css/ js/ and fonts/ changed to static/*");

    (my $new_index_content = "$dom") =~ s/QUOTEHERE/"/g;

    ## this won't be handled because it's not an html element
    ## attribute, and we're not parsing javascript (yet?)
    $new_index_content =~ s{\Qdocument.write('<script src="js/vendor/jquery-1.10.1.min.js">}
                           {document.write('<script src="[% c.uri_for("/static/js/vendor/jquery-1.10.1.min.js") %]">};

    ## replace it into the zip
    my $index_member = _safely_search_one_member( qr/index\.html$/ );
    my $index_name = $index_member->fileName;
    my($f,$d) = fileparse( $index_name );
    $az->contents( $index_member, $new_index_content );

    $index_member->fileName( $d."wrapper.tt2" );
    l->debug("HTML5: index.html changed to wrapper.tt2" );

}
sub _move_images {

    _require_az;

    ## change dir name from img/* to static/images/*

    my @img_members = $az->membersMatching(qr(/img/));

    if (not @img_members) {
        carp "did not find any img/ files in zip, this does not feel right";
        return;
    }

    for my $m (@img_members) {
        (my $new_name = $m->fileName) =~ s|/img/|/static/images/|;
        $m->fileName( $new_name );
    }

    l->debug(sprintf "HTML5: %d image(s) moved from img/ to images/",
         scalar(@img_members) );

}
sub _move_css_js_fonts {

    _require_az;

    ## change dir name from img/* to static/images/*

    my @static_members = $az->membersMatching(qr(/(?:css|js|fonts)/));

    if (not @static_members) {
        carp "did not find any js/ or css/ files in zip, that cannot be right";
        return;
    }

    for my $m (@static_members) {
        (my $new_name = $m->fileName) =~ s{/(css|js|fonts)/}{/static/$1/};
        $m->fileName( $new_name );
    }

    l->debug(sprintf "HTML5: %d css, js or fonts files moved to static/*",
         scalar(@static_members) );

}

## Low level functions:
sub _az {
    return $az;
}
sub _set_az_from_cache {

    my $zip_file = module_file( __PACKAGE__, "initializr-verekia-4.0.zip" );
    return $az //= Archive::Zip->new( $zip_file );

}
sub _safely_search_one_member {

    my ($qr,$allowed_to_live_when_doesnt_match) = @_;

    _require_az;

    my @m;

    if ( ref $qr eq "Regexp" ) {
        @m = $az->membersMatching({ regex => $qr });
    }
    else {
        @m = ($az->memberNamed( $qr ));
    }

    if ( @m != 1 and not $allowed_to_live_when_doesnt_match or @m > 1 ) {
        croak "Found 0 or more than one zip member match for '$qr'";
    }

    return $m[0];

}
sub _zip_content {

    my( $qr, $new_content ) = @_;

    _require_az;

    my $member = _safely_search_one_member($qr) or return;

    if ( $new_content ) {
        return $az->contents( $member, $new_content );
    }
    else {
        return $az->contents( $member );
    }
}
sub _index_dom {

    _require_az;

    my $h = _zip_content( qr/index\.html$/ );
    my $dom = Mojo::DOM->new( $h );

    return $dom;



( run in 2.262 seconds using v1.01-cache-2.11-cpan-524268b4103 )