package Git::Database::Role::PurePerlBackend; $Git::Database::Role::PurePerlBackend::VERSION = '0.007'; use Sub::Quote; use Path::Class qw( file ); # used by Git::PurePerl/Cogit use Git::Database::Object::Raw; #use namespace::clean; use Moo::Role; requires '_store_packs', ; with 'Git::Database::Role::Backend', 'Git::Database::Role::ObjectReader', 'Git::Database::Role::ObjectWriter', 'Git::Database::Role::RefReader', ; sub _expand_abbrev { my ( $self, $abbrev ) = @_; # some shortcuts return '' if !defined $abbrev; return lc $abbrev if $abbrev =~ /^[0-9a-fA-F]{40}$/; return '' if length $abbrev < 4; # basic implementation my @matches = grep /^$abbrev/, $self->all_digests; warn "error: short SHA1 $abbrev is ambiguous.\n" if @matches > 1; return @matches == 1 ? shift @matches : ''; } # Git::Database::Role::ObjectReader sub get_object_attributes { my ( $self, $digest ) = @_; # expand abbreviated digests $digest = $self->_expand_abbrev($digest) or return undef if $digest !~ /^[0-9a-f]{40}$/; # search packs for my $pack ( @{ $self->_store_packs } ) { my ( $kind, $size, $content ) = $pack->get_object($digest); if ( defined($kind) && defined($size) && defined($content) ) { return { kind => $kind, digest => $digest, content => $content, size => $size, }; } } # search loose objects my ( $kind, $size, $content ) = $self->store->loose->get_object($digest); if ( defined($kind) && defined($size) && defined($content) ) { return { kind => $kind, digest => $digest, content => $content, size => $size, }; } return undef; } sub all_digests { my ( $self, $kind ) = @_; return $self->store->all_sha1s->all if !$kind; return map $_->sha1, grep $_->kind eq $kind, $self->store->all_objects->all; } # Git::Database::Role::ObjectWriter sub put_object { my ( $self, $object ) = @_; $self->store->loose->put_object( Git::Database::Object::Raw->new($object) ); return $object->digest; } # Git::Database::Role::RefReader sub refs { my $store = $_[0]->store; my %refs = ( HEAD => $store->ref_sha1('HEAD') ); @refs{ $store->ref_names } = $store->refs_sha1; # get back to packed-refs to pick the primary target of the refs, # since Git::PurePerl's ref_sha1 peels everything to reach the commit if ( -f ( my $packed_refs = file( $store->gitdir, 'packed-refs' ) ) ) { for my $line ( $packed_refs->slurp( chomp => 1 ) ) { next if $line =~ /^[#^]/; my ( $sha1, $name ) = split ' ', $line; $refs{$name} = $sha1; } } return \%refs; } 1; __END__ =pod =for Pod::Coverage get_object_attributes all_digests put_object refs =head1 NAME Git::Database::Role::PurePerlBackend - Code shared by the Cogit and Git::PurePerl backends =head1 VERSION version 0.007 =head1 SYNOPSIS package MyPurePerlBackend; use Moo; use namespace::clean; with 'Git::Database::Role::PurePerlBackend'; # implement the required methods sub _store_packs { ... } 1; =head1 DESCRIPTION This role contains the code shared by the L and L backends. Both backends share the same API, except for one tiny difference: one returns its packs as a list, and the other as an array reference. This role hides the difference behind a simple interface. =head1 AUTHOR Philippe Bruhat (BooK) =head1 COPYRIGHT Copyright 2016 Philippe Bruhat (BooK), all rights reserved. =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut