view release on metacpan or  search on metacpan

bin/abcache  view on Meta::CPAN

#!/usr/bin/perl

use strict;
use warnings;
use autodie;
use 5.010001;
use Path::Tiny qw( path );
use Pod::Usage qw( pod2usage );
use Getopt::Long qw( GetOptions );
use Sereal 3.015 qw( decode_sereal );
use File::Glob qw( bsd_glob );
use URI;
use Number::Bytes::Human qw( format_bytes );

# ABSTRACT: Command line interface to Alien::Build::Plugin::Fetch::Cache
# PODNAME: abcache
our $VERSION = '0.05'; # VERSION


my $opt_list;
my $opt_clear;

GetOptions(
  'list'      => \$opt_list,
  'clear'     => \$opt_clear,
  'version|v' => sub { say "abcache (Alien::Build::Plugin::Fetch::Cache) version @{[ $main::VERSION // 'dev' ]}" },
  'help|h'    => sub { pod2usage( -exitval => 0 ) },
) || pod2usage( -exitval => 2 );

my $root = path(bsd_glob '~/.alienbuild/plugin_fetch_cache');

sub recurse
{
  my $cb = shift;
  my $dir = shift // $root;
  my $list = shift // [];

  foreach my $child (sort $dir->children)
  {
    next unless -d $child;
    if(-d $child)
    {
      recurse($cb, $child, [ @$list, $child->basename ]);
    }
  }

  my $meta = $dir->child('meta');
  if(-f $meta)
  {
    my($scheme, $host, @rest) = @$list;
    my $uri = URI->new;
    $uri->scheme($scheme);
    $uri->host($host);
    $uri->path(join('/', @rest));
    $cb->($uri, decode_sereal($meta->slurp_raw), $meta);
  }

}

if($opt_list)
{
  recurse(sub {
    my($uri, $meta, $metafile) = @_;

    my $size = 0;
    my $age  = 0;
    if($meta->{path})
    {
      $size = -s $meta->{path};
      $age  = -A $meta->{path};
    }
    elsif($meta->{content})
    {
      $size = do { use bytes; length $meta->{content} };
      $age  = -A $metafile;
    }

    printf "%5s %5s %s\n", format_bytes($size), int($age), $uri;
  });
}
elsif($opt_clear)
{
  my $rm = sub {
    say "RM    $_[0]";
    unlink $_[0];
  };
  my $rmdir = sub {
    say "RMDIR $_[0]";
    rmdir $_[0];
  };