local-lib5/lib/perl5/Git/PurePerl/Loose.pm

   1 package Git::PurePerl::Loose;
   2 use Moose;
   3 use MooseX::StrictConstructor;
   4 use MooseX::Types::Path::Class;
   5 use Compress::Zlib qw(compress uncompress);
   6 use Path::Class;
   7 use namespace::autoclean;
   8
   9 has 'directory' => (
  10     is       => 'ro',
  11     isa      => 'Path::Class::Dir',
  12     required => 1,
  13     coerce   => 1
  14 );
  15
  16 sub get_object {
  17     my ( $self, $sha1 ) = @_;
  18
  19     my $filename
  20         = file( $self->directory, substr( $sha1, 0, 2 ), substr( $sha1, 2 ) );
  21     return unless -f $filename;
  22
  23     my $compressed = $filename->slurp;
  24     my $data       = uncompress($compressed);
  25     my ( $kind, $size, $content ) = $data =~ /^(\w+) (\d+)\0(.+)$/s;
  26     return ( $kind, $size, $content );
  27 }
  28
  29 sub put_object {
  30     my ( $self, $object ) = @_;
  31
  32     my $filename = file(
  33         $self->directory,
  34         substr( $object->sha1, 0, 2 ),
  35         substr( $object->sha1, 2 )
  36     );
  37     $filename->parent->mkpath;
  38     my $compressed = compress( $object->raw );
  39     my $fh         = $filename->openw;
  40     binmode($fh); #important for Win32
  41     $fh->print($compressed) || die "Error writing to $filename: $!";
  42 }
  43
  44 sub all_sha1s {
  45     my $self  = shift;
  46     my $files = Data::Stream::Bulk::Path::Class->new(
  47         dir        => $self->directory,
  48         only_files => 1,
  49     );
  50     return Data::Stream::Bulk::Filter->new(
  51         filter => sub {
  52             [   map { m{([a-z0-9]{2})[/\\]([a-z0-9]{38})}; $1 . $2 }
  53                     grep {m{[/\\][a-z0-9]{2}[/\\]}} @$_
  54             ];
  55         },
  56         stream => $files,
  57     );
  58 }
  59
  60 __PACKAGE__->meta->make_immutable;
  61