test-project-packs2.tgz @@ -1,4 +1,7 @@ Revision history for Perl module Git::PurePerl: +0.33 + - add support for version 2 pack index files + 0.32 Fri Nov 14 16:47:59 GMT 2008 - initial release CHANGES @@ -12,5 +12,6 @@ README t/00_setup.t t/simple.t test-project-packs.tgz +test-project-packs2.tgz test-project.tgz MANIFEST @@ -8,7 +8,8 @@ use IO::File; has 'filename' => ( is => 'ro', isa => 'Path::Class::File', required => 1, coerce => 1 ); -has 'version' => ( is => 'rw', isa => 'Int', required => 0 ); +has 'version' => ( is => 'rw', isa => 'Int', required => 0 ); +has 'global_offset' => ( is => 'rw', isa => 'Int', required => 0 ); has 'offsets' => ( is => 'rw', isa => 'ArrayRef[Int]', required => 0, auto_deref => 1, ); @@ -39,6 +40,7 @@ sub BUILD { my $fh = $self->open_index; $fh->read( my $signature, 4 ); $fh->read( my $version, 4 ); + $version = unpack( 'N', $version ); if ( $signature eq "\377tOc" ) { confess("Unknown version") if $version != 2; @@ -46,20 +48,28 @@ sub BUILD { $version = 1; } $self->version($version); + + if ( $version == 1 ) { + $self->global_offset(0); + } else { + $self->global_offset(8); + } + my @offsets = (0); foreach my $i ( 0 .. $FanOutCount - 1 ) { - $fh->seek( $i * $IdxOffsetSize, 0 ); + $fh->seek( ( $i * $IdxOffsetSize ) + $self->global_offset, 0 ); $fh->read( my $data, $IdxOffsetSize ); my $offset = unpack( 'N', $data ); confess("pack has discontinuous index") if $offset < $offsets[-1]; push @offsets, $offset; } + $self->size( $offsets[-1] ); } sub open_index { - my $self = shift; - my $filename = $self->filename; + my $self = shift; + my $filename = $self->filename; my $index_filename = $filename; $index_filename =~ s/\.pack/.idx/; my $fh = IO::File->new($index_filename) || confess($!); @@ -75,20 +85,56 @@ sub open_pack { sub get_object { my ( $self, $want_sha1 ) = @_; - my $fh = $self->open_index; - my $pos = $OffsetStart; - foreach my $i ( 1 .. $self->size ) { - $fh->seek( $pos, 0 ) || die $!; - $fh->read( my $data, $OffsetSize ) || die $!; - my $offset = unpack( 'N', $data ); - $fh->read( $data, $SHA1Size ) || die $!; - my $sha1 = unpack( 'H*', $data ); - if ( $sha1 eq $want_sha1 ) { - return $self->unpack_object($offset); + + if ( $self->version == 1 ) { + my $fh = $self->open_index; + my $pos = $OffsetStart; + foreach my $i ( 1 .. $self->size ) { + $fh->seek( $pos, 0 ) || die $!; + $fh->read( my $data, $OffsetSize ) || die $!; + my $offset = unpack( 'N', $data ); + $fh->read( $data, $SHA1Size ) || die $!; + my $sha1 = unpack( 'H*', $data ); + if ( $sha1 eq $want_sha1 ) { + return $self->unpack_object($offset); + } + $pos += $EntrySize; } - $pos += $EntrySize; + return; + + } else { + + my $fh = $self->open_index; + my @data; + my $pos = $OffsetStart; + foreach my $i ( 0 .. $self->size - 1 ) { + $fh->seek( $pos + $self->global_offset, 0 ) || die $!; + $fh->read( my $sha1, $SHA1Size ) || die $!; + $data[$i] = [ unpack( 'H*', $sha1 ), 0, 0 ]; + $pos += $SHA1Size; + } + foreach my $i ( 0 .. $self->size - 1 ) { + $fh->seek( $pos + $self->global_offset, 0 ) || die $!; + $fh->read( my $crc, $CrcSize ) || die $!; + $data[$i]->[1] = unpack( 'H*', $crc ); + $pos += $CrcSize; + } + foreach my $i ( 0 .. $self->size - 1 ) { + $fh->seek( $pos + $self->global_offset, 0 ) || die $!; + $fh->read( my $offset, $OffsetSize ) || die $!; + $data[$i]->[2] = unpack( 'N', $offset ); + $pos += $OffsetSize; + } + + foreach my $data (@data) { + my ( $sha1, $crc, $offset ) = @$data; + if ( $sha1 eq $want_sha1 ) { + return $self->unpack_object($offset); + } + } + return; + } - return; } sub unpack_object { lib/Git/PurePerl/Pack.pm @@ -4,7 +4,7 @@ use warnings; use Test::More tests => 1; use Archive::Extract; -foreach my $name qw(test-project test-project-packs) { +foreach my $name qw(test-project test-project-packs test-project-packs2) { next if -d $name; my $ae = Archive::Extract->new( archive => "$name.tgz" ); $ae->extract; @@ -13,7 +13,7 @@ ok(1, 'extracted'); =for shell -How to create test-project and test-project-packs: +# How to create test-project and test-project-packs: mkdir test-project cd test-project @@ -37,4 +37,7 @@ mv test-project test-project-packs tar fvzc test-project-packs.tgz test-project-packs rm -rf test-project-packs +# and likewise but on a recent git for test-project-packs2 +tar fvzc test-project-packs2.tgz test-project-packs2 + =cut t/00_setup.t @@ -1,17 +1,18 @@ #!perl use strict; use warnings; -use Test::More tests => 34; +use Test::More tests => 51; use Git::PurePerl; -foreach my $directory qw(test-project test-project-packs) { +foreach my $directory qw(test-project test-project-packs test-project-packs2) { my $git = Git::PurePerl->new( directory => $directory ); my $master = $git->master; - is( $master->kind, 'commit' ); - is( $master->size, 256 ); - is( $master->sha1, 'd60f7006a71288b70601fa6057fd3727842a74a0' ); - is( $master->tree, '37b4fcd62571f07408e830f455268891f95cecf5' ); - is( $master->parent, 'bb99a61fd2035d672d075ea4b72d17ac0d1c193e' ); + + is( $master->kind, 'commit' ); + is( $master->size, 256 ); + like( $master->sha1, qr/^[a-z0-9]{40}$/ ); + is( $master->tree, '37b4fcd62571f07408e830f455268891f95cecf5' ); + like( $master->parent, qr/^[a-z0-9]{40}$/ ); like( $master->author, qr/^Your Name Comes Here <you\@yourdomain.example.com>/ ); like( $master->committer, t/simple.t 5069f21b4f49bcc810938c5463f084839f880c10 Leon Brocard acme@astray.com http://github.com/acme/git-pureperl/commit/d7dc95750fbb4f2cb82ee9791863559ebf05542e d7dc95750fbb4f2cb82ee9791863559ebf05542e 2008-11-19T10:58:39-08:00 2008-11-19T10:58:39-08:00 add support for version 2 pack index files e57eec2f65ea48395f894f2b4d135186f48e3574 Leon Brocard acme@astray.com