File Coverage

blib/lib/Alien/Build/Plugin/Fetch/Cache.pm

Criterion	Covered	Total	%
statement	59	73	80.8
branch	13	24	54.1
condition	4	15	26.6
subroutine	12	13	92.3
pod	1	1	100.0
total	89	126	70.6

package Alien::Build::Plugin::Fetch::Cache;

use strict;
use warnings;
use 5.010001;
use Alien::Build::Plugin;
use URI 1.71;
use Path::Tiny 0.100 ();
use Sereal 3.015 qw( encode_sereal decode_sereal );
use Digest::MD5;
use File::Glob qw( bsd_glob );

# ABSTRACT: Alien::Build plugin to cache files downloaded from the internet
our $VERSION = '0.05'; # VERSION


sub _local_file
{
  my($uri) = @_;

  Path::Tiny
    ->new(bsd_glob '~/.alienbuild/plugin_fetch_cache')
    ->child($uri->scheme)
    ->child($uri->host)
    ->child($uri->path)
    ->child('meta');
}

sub init
{
  my($self, $meta) = @_;

  $meta->around_hook(
    fetch => sub {
      my($orig, $build, $url) = @_;
      my $local_file;

      my $cache_url = $url // $build->meta_prop->{start_url};

      if($cache_url && $cache_url !~ m!^/!  && $cache_url !~ m!^file:!)
      {
        my $uri = URI->new($cache_url);
        $local_file = _local_file($uri);
        if(-r $local_file)
        {
          $build->log("using cached response for $uri");
          return decode_sereal($local_file->slurp_raw);
        }
      }
      my $res = $orig->($build, $url);

      if(defined $local_file)
      {
        $local_file->parent->mkpath;
        if($res->{type} eq 'file')
        {
          my $md5 = Digest::MD5->new;

          if($res->{content})
          {
            $md5->add($res->{content});
          }
          else
          {
            open my $fh, '<', $res->{path};
            $md5->addfile($fh);
            close $fh;
          }

          my $data = Path::Tiny->new(bsd_glob '~/.alienbuild/plugin_fetch_cache/payload')
                     ->child($md5->hexdigest)
                     ->child($res->{filename});
          $data->parent->mkpath;

          my $res2 = {
            type     => 'file',
            filename => $res->{filename},
            path     => $data->stringify,
            protocol => $res->{protocol},
          };
          if($res->{content})
          {
            $data->spew_raw($res->{content});
          }
          elsif($res->{path})
          {
            Path::Tiny->new($res->{path})->copy($data);
          }
          else
          {
            die "got a file without contant or path";
          }
          $local_file->spew_raw( encode_sereal $res2 );
        }
        elsif($res->{type} =~ /^(list|html|dir_listing)$/)
        {
          $local_file->spew_raw( encode_sereal $res );
        }
      }

      $res;
    }
  );

  if($ENV{ALIEN_BUILD_PLUGIN_FETCH_CACHE_PRECACHE})
  {
    $meta->around_hook(
      prefer => sub {
        my($orig, $build, @rest) = @_;
        my $ret = $orig->($build, @rest);

        if($ret->{type} eq 'list')
        {
          foreach my $file (@{ $ret->{list} })
          {
            my $url = $file->{url};
            if($url && $url !~ m!^/!  && $url !~ m!^file:!)
            {
              my $local_file = _local_file(URI->new($url));
              next if -f $local_file;
              $build->log("precacheing $url");
              $build->fetch($url);
            }
          }
        }
        $ret;
      },
    );
  }
}


1;

__END__