Commit | Line | Data |
3fea05b9 |
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 | |