Catalyst-Controller-AutoAssets

 view release on metacpan or  search on metacpan

lib/Catalyst/Controller/AutoAssets/Handler.pm  view on Meta::CPAN

package Catalyst::Controller::AutoAssets::Handler;
use strict;
use warnings;

# VERSION

use Moose::Role;
use namespace::autoclean;

requires qw(
  asset_request
  write_built_file
);

use Cwd;
use Path::Class 0.32 qw( dir file );
use Fcntl qw( :DEFAULT :flock );
use Carp;
use File::stat qw(stat);
use Catalyst::Utils;
use Time::HiRes qw(gettimeofday tv_interval);
use Storable qw(store retrieve);
use Try::Tiny;
use Data::Dumper::Concise 'Dumper';

require Digest::SHA1;
require MIME::Types;
require Module::Runtime;

has 'Controller' => (
  is => 'ro', required => 1,
  isa => 'Catalyst::Controller::AutoAssets',
  handles => [qw(type _app action_namespace unknown_asset _build_params _module_version)],
);

# Directories to include
has 'include', is => 'ro', isa => 'ScalarRef|Str|ArrayRef[ScalarRef|Str]', required => 1;

# Optional regex to require files to match to be included
has 'include_regex', is => 'ro', isa => 'Maybe[Str]', default => undef;

# Optional regex to exclude files
has 'exclude_regex', is => 'ro', isa => 'Maybe[Str]', default => undef;

# Whether or not to use qr/$regex/i or qr/$regex/
has 'regex_ignore_case', is => 'ro', isa => 'Bool', default => 0;

# Whether or not to make the current asset available via 307 redirect to the
# real, current checksum/fingerprint asset path
has 'current_redirect', is => 'ro', isa => 'Bool', default => 1;

# What string to use for the 'current' redirect
has 'current_alias', is => 'ro', isa => 'Str', default => 'current';

# Whether or not to make the current asset available via a static path
# with no benefit of caching
has 'allow_static_requests', is => 'ro', isa => 'Bool', default => 0;

# What string to use for the 'static' path
has 'static_alias', is => 'ro', isa => 'Str', default => 'static';

# Extra custom response headers for current/static requests 
has 'current_response_headers', is => 'ro', isa => 'HashRef', default => sub {{}};
has 'static_response_headers', is => 'ro', isa => 'HashRef', default => sub {{}};

# Whether or not to set 'Etag' response headers and check 'If-None-Match' request headers
# Very useful when using 'static' paths
has 'use_etags', is => 'ro', isa => 'Bool', default => 0;

# Max number of seconds before recalculating the fingerprint (sha1 checksum)
# regardless of whether or not the mtime has changed. 0 means infinite/disabled
has 'max_fingerprint_calc_age', is => 'ro', isa => 'Int', default => sub {0};

# Max number of seconds to wait to obtain a lock (to be thread safe)
has 'max_lock_wait', is => 'ro', isa => 'Int', default => 120;

has 'cache_control_header', is => 'ro', isa => 'Str', 
  default => sub { 'public, max-age=31536000, s-max-age=31536000' }; # 31536000 = 1 year

# Whether or not to use stored state data across restarts to avoid rebuilding.
has 'persist_state', is => 'ro', isa => 'Bool', default => sub{0};

# Optional shorter checksum
has 'sha1_string_length', is => 'ro', isa => 'Int', default => sub{40};

# directory to use for relative includes (defaults to the Catalyst home dir);
# TODO: coerce from Str
has 'include_relative_dir', isa => 'Path::Class::Dir', is => 'ro', lazy => 1, default => sub { 
  my $self = shift;
  my $home = $self->_app->config->{home};
  $home = $home && -d $home ? $self->_app->config->{home} : cwd();
  return dir( $home );
};



######################################


sub BUILD {}
before BUILD => sub {
  my $self = shift;
  
  # optionally initialize state data from the copy stored on disk for fast
  # startup (avoids having to always rebuild after every app restart):
  $self->_restore_state if($self->persist_state);

  # init includes
  $self->includes;
  
  Catalyst::Exception->throw("Must include at least one file/directory")
    unless (scalar @{$self->includes} > 0);

  # if the user picks something lower than 5 it is probably a mistake (really, anything
  # lower than 8 is probably not a good idea. But the full 40 is probably way overkill)
  Catalyst::Exception->throw("sha1_string_length must be between 5 and 40")
    unless ($self->sha1_string_length >= 5 && $self->sha1_string_length <= 40);

  # init work_dir:
  $self->work_dir->mkpath($self->_app->debug);
  $self->work_dir->resolve;
  
  $self->prepare_asset;
};

lib/Catalyst/Controller/AutoAssets/Handler.pm  view on Meta::CPAN

    $self->asset_request($c, $arg, @args);
  }
  return $c->detach;
}

sub client_current_etag {
  my ( $self, $c, $arg, @args ) = @_;
  
  my $etag = $self->etag_value(@args);
  $c->response->header( Etag => $etag );
  my $client_etag = $c->request->headers->{'if-none-match'};
  return ($client_etag && $client_etag eq $etag) ? 1 : 0;
}

sub etag_value {
  my $self = shift;
  return '"' . join('/',$self->asset_name,@_) . '"';
}


############################


has 'work_dir', is => 'ro', isa => 'Path::Class::Dir', lazy => 1, default => sub {
  my $self = shift;
  my $c = $self->_app;
  
  my $tmpdir = Catalyst::Utils::class2tempdir($c)
    || Catalyst::Exception->throw("Can't determine tempdir for $c");
    
  return dir($tmpdir, "AutoAssets",  $self->action_namespace($c));
};

has 'built_file', is => 'ro', isa => 'Path::Class::File', lazy => 1, default => sub {
  my $self = shift;
  my $filename = 'built_file';
  return file($self->work_dir,$filename);
};

has 'scratch_dir', is => 'ro', isa => 'Path::Class::Dir', lazy => 1, default => sub {
  my $self = shift;
  
  my $Dir = dir($self->work_dir,'_scratch');
  $Dir->rmtree if (-d $Dir);
  $Dir->mkpath;
  
  return $Dir
};

has 'fingerprint_file', is => 'ro', isa => 'Path::Class::File', lazy => 1, default => sub {
  my $self = shift;
  return file($self->work_dir,'fingerprint');
};

has 'lock_file', is => 'ro', isa => 'Path::Class::File', lazy => 1, default => sub {
  my $self = shift;
  return file($self->work_dir,'lockfile');
};


has 'includes', is => 'ro', isa => 'ArrayRef', lazy => 1, default => sub {
  my $self = shift;
  my $rel = $self->include_relative_dir;

  my @list = ((ref $self->include)||'') eq 'ARRAY' ? @{$self->include} : $self->include;
  my $i = 0;
  return [ map {
    my $inc; $i++;
    if((ref($_)||'') eq 'SCALAR') {
      # New support for ScalarRef includes ... we pre-dump them to a temp file
      $inc = file( $self->scratch_dir, join('','_generated_include_file_',$i) );
      $inc->spew(iomode => '>:raw', $$_);
    }
    else {
      $inc = file($_);
    }
    $inc = $rel->file($inc) unless ($inc->is_absolute);
    $inc = dir($inc) if (-d $inc); #<-- convert to Path::Class::Dir
    $inc->resolve
  } @list ];
};




sub get_include_files {
  my $self = shift;
  
  my @excluded = ();
  my @files = ();
  for my $inc (@{$self->includes}) {
    if($inc->is_dir) {
      $inc->recurse(
        preorder => 1,
        depthfirst => 1,
        callback => sub {
          my $child = shift;
          $self->_valid_include_file($child)
            ? push @files, $child->absolute
            : push @excluded, $child->absolute;
        }
      );
    }
    else {
      $self->_valid_include_file($inc) 
        ? push @files, $inc->absolute 
        : push @excluded, $inc->absolute;
    }
  }
  
  # Some handlers (like Directory) need to know about excluded files
  $self->_record_excluded_files(\@excluded);
  
  # force consistent ordering of files:
  return [sort @files];
}

# optional hook for excluded files:
sub _record_excluded_files {}

lib/Catalyst/Controller/AutoAssets/Handler.pm  view on Meta::CPAN

has 'built_mtime', is => 'rw', isa => 'Maybe[Str]', default => sub{undef};
sub get_built_mtime {
  my $self = shift;
  return -f $self->built_file ? $self->built_file->stat->mtime : undef;
}

# inc_mtimes are the mtime(s) of the include files. For directory assets
# this is *only* the mtime of the top directory (see subfile_meta below)
has 'inc_mtimes', is => 'rw', isa => 'Maybe[Str]', default => undef;
sub get_inc_mtime_concat {
  my $self = shift;
  my $list = shift;
  return join('-', map { $_->stat->mtime } @$list );
}


sub calculate_fingerprint {
  my $self = shift;
  my $list = shift;
  # include both the include (source) and built (output) in the fingerprint:
  my $sha1 = $self->file_checksum(@$list,$self->built_file);
  $self->last_fingerprint_calculated(time) if ($sha1);
  return $sha1;
}

sub current_fingerprint {
  my $self = shift;
  return undef unless (-f $self->fingerprint_file);
  my $fingerprint = $self->fingerprint_file->slurp(iomode => '<:raw');
  return $fingerprint;
}

sub save_fingerprint {
  my $self = shift;
  my $fingerprint = shift or die "Expected fingerprint/checksum argument";
  return $self->fingerprint_file->spew(iomode => '>:raw', $fingerprint);
}

sub calculate_save_fingerprint {
  my $self = shift;
  my $fingerprint = $self->calculate_fingerprint(@_) or return 0;
  return $self->save_fingerprint($fingerprint);
}

sub fingerprint_calc_current {
  my $self = shift;
  my $last = $self->last_fingerprint_calculated or return 0;
  return 1 if ($self->max_fingerprint_calc_age == 0); # <-- 0 means infinite
  return 1 if (time - $last < $self->max_fingerprint_calc_age);
  return 0;
}

# -----
# Quick and dirty state persistence for faster startup
has 'persist_state_file', is => 'ro', isa => 'Path::Class::File', lazy => 1, default => sub {
  my $self = shift;
  return file($self->work_dir,'state.dat');
};

has '_persist_attrs', is => 'ro', isa => 'ArrayRef', default => sub{[qw(
 built_mtime
 inc_mtimes
 last_fingerprint_calculated
)]};

sub _persist_state {
  my $self = shift;
  return undef unless ($self->persist_state);
  my $data = { map { $_ => $self->$_ } @{$self->_persist_attrs} };
  $data->{_module_version} = $self->_module_version;
  $data->{_build_params} = $self->_build_params;
  store $data, $self->persist_state_file;
  return $data;
}

sub _restore_state {
  my $self = shift;
  return 0 unless (-f $self->persist_state_file);
  my $data;
  try {
    $data = retrieve $self->persist_state_file;
    if($self->_valid_state_data($data)) {
      $self->$_($data->{$_}) for (@{$self->_persist_attrs});
    }
  }
  catch {
    $self->clear_asset; #<-- make sure no partial state data is used
    $self->_app->log->warn(
      'Failed to restore state from ' . $self->persist_state_file
    );
  };
  return $data;
}

sub _valid_state_data {
  my ($self, $data) = @_;
  
  # Make sure the version and config params hasn't changed
  return (
    $self->_module_version eq $data->{_module_version}
    && Dumper($self->_build_params) eq Dumper($data->{_build_params})
  ) ? 1 : 0;
}
# -----


# force rebuild on next request/prepare_asset
sub clear_asset {
  my $self = shift;
  $self->inc_mtimes(undef);
}

sub _build_required {
  my ($self, $d) = @_;
  return (
    $self->inc_mtimes && $self->built_mtime &&
    $d->{inc_mtimes} && $d->{built_mtime} &&
    $self->inc_mtimes eq $d->{inc_mtimes} &&
    $self->built_mtime eq $d->{built_mtime} &&
    $self->fingerprint_calc_current