view release on metacpan or  search on metacpan

bin/abcache  view on Meta::CPAN

  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];
  };
  recurse(sub {
    my($uri, $meta, $metafile) = @_;

    my $dir = $metafile->parent;

    if($meta->{path})
    {
      $rm->($meta->{path});
    }

    $rm->($metafile);

    $rmdir->($dir);

  });
}
else
{
  pod2usage( -exitval =>2, msg => 'you must specify at least one of --list, --clear' );
}

__END__

=pod

=encoding UTF-8

=head1 NAME

abcache - Command line interface to Alien::Build::Plugin::Fetch::Cache

=head1 VERSION

version 0.05

=head1 SYNOPSIS

 % abcache --list
 % abcache --clear

=head1 DESCRIPTION

This program provides a command line interface to the L<Alien::Build> plugin
C<Fetch::Cache>, which allows you to list or clear the cache.

=head1 OPTIONS

=head2 --list

List all the items in the cache.

=head2 --clear

Clear all the items in the cache.

=head1 SEE ALSO

=over 4

=item L<Alien>

=item L<Alien::Build>

=item L<Alien::Build::Plugin::Fetch::Cache>