File Coverage

blib/lib/Mojolicious/Command/bundle.pm

Criterion	Covered	Total	%
statement	36	90	40.0
branch	6	36	16.6
condition	2	13	15.3
subroutine	9	21	42.8
pod	1	1	100.0
total	54	161	33.5

package Mojolicious::Command::bundle;

=head1 NAME

Mojolicious::Command::bundle - Bundle assets from other projects

=head1 VERSION

0.01

=head1 DESCRIPTION

L is a command for fetching online
assets and bundle them with your project.

Bundling are done with C, where the remote L
is added to the current git project. The files are then copied into a
C directory. Updating the files to the
latest remote version is as easy as running the same command again, or
optionally with a different L.

The git process is I accomplised using submodules, nor subtree. The
reason is that it seems a lot more flexible being able to jump between
branches and tags as you like.

Please L
and issue if you have defined your own L repository.

=head1 SYNOPSIS

Usage:

  $ mojo bundle
  $ mojo bundle materialize
  $ mojo bundle materialize v0.97.1

=head1 REPOSITORIES

=head2 bootstrap

Bundle the L project.

=head2 materializecss

Bundle the L project.

See L for more details.

=head2 custom

This is not a real repository, but it is possible to specify locations with
a config file in the current working directory:

  $ cat - > .mojo_bundle.json
  {
    "materialize": {
      "download_url": "https://github.com/Dogfalo/materialize/archive/$version.tar.gz",
      "git_url": "https://github.com/Dogfalo/materialize.git"
    }
  }

The content of this file will be merged with the default L.

"download_url" is only required as a fallback, in case
L is not installed.

=head1 ENVIRONMENT VARIABLES

=head2 GIT_BIN

Path to your "git" executable. The default is to use L to
find the executable.

=head2 MOJO_ASSET_OUT_DIR

Path to where the root of the repositories should be. Defaults to "assets/vendor".

=cut

use Mojo::Base 'Mojolicious::Command';
use Mojo::Util qw( spurt slurp );
use Mojo::JSON 'decode_json';
use File::Temp  ();
use File::Which ();
use File::Spec::Functions qw( catdir catfile );

use constant GIT_BIN => $ENV{GIT_BIN} // File::Which::which('git') || '';
use constant OUT_DIR => $ENV{MOJO_ASSET_OUT_DIR} || catdir 'assets', 'vendor';

our $VERSION = '0.01';

=head1 ATTRIBUTES

=head2 description

  $str = $self->description;

Returns short description of this command.

=head2 repositories

  $hash_ref = $self->repositories;

Holds a mapping between repository name and resource URLs.
See L for default value.

=head2 usage

  $str = $self->usage;

Returns how to use this command.

=cut

has description => 'Command for making remote assets available locally.';

has repositories => sub {
  my $self         = shift;
  my $repositories = $self->_default_repositories;

  if (-e '.mojo_bundle') {
    my $extra = decode_json slurp '.mojo_bundle';
    @$repositories{keys %$extra} = values %$extra;
  }

  return $repositories;
};

has usage => sub {
  my $self  = shift;
  my $usage = "Usage:\n\n";

  for my $repo (sort keys %{$self->repositories}) {
    next unless $repo =~ /^[a-z]/;
    $usage .= "  \$ mojo bundle $repo \n";
  }

  return "$usage\n";
};

=head1 METHODS

=head2 run

Command start point.

=cut

sub run {
  my $self = shift;
  my $method = GIT_BIN ? '_git_fetch' : '_download';

  return $self->$method(@_);
}

sub _default_repositories {
  return {
    bootstrap => {
      git_url      => 'https://github.com/twbs/bootstrap.git',
      download_url => 'https://github.com/twbs/bootstrap/archive/$version.zip',
    },
    materialize => {
      git_url      => 'https://github.com/Dogfalo/materialize.git',
      download_url => 'https://github.com/Dogfalo/materialize/archive/$version.tar.gz',
    }
  };
}

sub _download {
  my $self    = shift;
  my $repo    = shift || '';
  my $version = shift || 'master';

  die 'TODO: Fetch .tar.gz';
}

sub _git {
  my $cb      = ref $_[-1] eq 'CODE'   ? pop : undef;
  my $comment = $_[-1] =~ /^\#\s*(.*)/ ? pop : undef;
  my ($self, @cmd) = @_;
  my $exit;

  if (defined $comment) {
    warn "$comment\n" if $comment =~ /\w/;
  }
  elsif (!$self->quiet) {
    warn "+ git @cmd\n";
  }

  if ($cb) {
    my $pid = open my $GIT, '-|', GIT_BIN, @cmd or die "git @cmd: $!";
    while (<$GIT>) {
      chomp;
      $cb->();
    }
    waitpid $pid, 0;
    $exit = $? >> 8;
  }
  else {
    system GIT_BIN, @cmd;
    $exit = $? >> 8;
    die "! git @cmd: \$?=$exit\n" if $exit;
  }

  return $exit;
}

sub _git_fetch {
  my $self        = shift;
  my $repo        = shift || '';
  my $version     = shift || 'master';
  my $url         = $self->repositories->{$repo}{git_url} or die $self->usage;
  my $latest_file = $self->_latest_file($repo);
  my $object      = "$repo/$version";
  my $vendor_dir  = catfile OUT_DIR, $repo;
  my ($exists, $latest_commit);

  $self->_git(qw( remote -v ), '#', sub { /^$repo\b/ and $exists = 1 });
  $self->_git(qw( remote add ), $repo => $url) unless $exists;
  $self->_git(qw( remote update ), $repo);
  $self->_git(qw( tag ), '#', sub { $object = $_ if $_ eq $version });

  if (-e $latest_file) {
    $latest_commit = slurp $latest_file;
    chomp $latest_commit;
    open my $GIT_APPLY, '|-', GIT_BIN, 'apply';
    $self->_git(
      qw( diff-tree -p --binary ),
      '--dst-prefix' => "b/$vendor_dir/",
      '--src-prefix' => "a/$vendor_dir/",
      $latest_commit, $object, sub { print $GIT_APPLY "$_\n" },
    );
    close $GIT_APPLY or die "git apply: $!";
    $self->_git(add => $vendor_dir);
  }
  else {
    File::Path::make_path($vendor_dir) unless -d $vendor_dir;
    $self->_git(qw( read-tree -u ), "--prefix=$vendor_dir", $object);
  }

  unless ($self->_git(qw( diff --cached --quiet ), '# Checking for changes', sub { })) {
    return warn "Updated $repo/$version, but no changes was found.\n";
  }

  my $tmp = File::Temp->new;
  my $msg = sprintf "%s %s from %s %s\n", $latest_commit ? "Updated" : "Created", $vendor_dir, $url, $version;
  print $tmp "$msg\n";

  if ($latest_commit) {
    $self->_git(qw( log --no-color --oneline ), "$latest_commit..$object", '#', sub { print $tmp "    $_\n" });
  }

  close $tmp;    # flush content
  $self->_git(qw( log --format=%H -n1 ), $object, '#', sub { spurt $_ => $latest_file });
  $self->_git(qw( add ), $latest_file);
  $self->_git(qw( commit -F ), $tmp, sub { });
  warn "# $msg";
  return 0;
}

sub _latest_file { catfile OUT_DIR, ".$_[1].latest"; }

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2014, Jan Henning Thorsen

This program is free software, you can redistribute it and/or modify it under
the terms of the Artistic License version 2.0.

=head1 AUTHOR

Jan Henning Thorsen - C

=cut

1;