make sure zlib data is always read as-is

CHANGES

@@ -1,5 +1,15 @@
 Revision history for Perl module Git::PurePerl:
 
+0.48 Thu Jul 14 22:53:55 BST 2011
+     - Translation from Digest::SHA1 to Digest::SHA (Jonas Genannt)
+     - A git object can also be of zero size. (Christian Walde)
+     - Only the last SHA1 for any given ref is returned from
+       ref_sha1() (Christian Walde)
+     - Make sure zlib data is always read as-is (Christian Walde)
+
+0.47 Wed Aug 11 13:29:06 BST 2010
+     - Lazily build the fh attribute of Git::PurePerl::Pack objects.
+
 0.46_01 Sat 16 Jan 13:42:00 GMT 2010
      - Add support for ssh:// and file:// protocols (Alex Vandiver)
 

Makefile.PL

@@ -17,7 +17,6 @@ requires        'Compress::Zlib'             => '0';
 requires        'Config::GitLike'            => '0';
 requires        'Data::Stream::Bulk'         => '0';
 requires        'DateTime'                   => '0';
-requires        'Digest::SHA1'               => '0';
 requires        'File::Find::Rule'           => '0';
 requires        'IO::Digest'                 => '0';
 requires        'Moose'                      => '0';

lib/Git/PurePerl.pm

@@ -7,7 +7,7 @@ use Data::Stream::Bulk;
 use Data::Stream::Bulk::Array;
 use Data::Stream::Bulk::Path::Class;
 use DateTime;
-use Digest::SHA1;
+use Digest::SHA;
 use File::Find::Rule;
 use Git::PurePerl::Actor;
 use Git::PurePerl::Config;
@@ -37,7 +37,7 @@ use IO::Socket::INET;
 use Path::Class;
 use namespace::autoclean;
 
-our $VERSION = '0.46_01';
+our $VERSION = '0.48';
 $VERSION = eval $VERSION;
 
 has 'directory' => (
@@ -155,6 +155,7 @@ sub ref_names {
     if ( -f $packed_refs ) {
         foreach my $line ( $packed_refs->slurp( chomp => 1 ) ) {
             next if $line =~ /^#/;
+            next if $line =~ /^\^/;
             my ( $sha1, my $name ) = split ' ', $line;
             push @names, $name;
         }
@@ -174,7 +175,6 @@ sub refs {
 
 sub ref_sha1 {
     my ( $self, $wantref ) = @_;
-    my @refs;
     my $dir = dir( $self->gitdir, 'refs' );
     return unless -d $dir;
 
@@ -183,8 +183,7 @@ sub ref_sha1 {
         my $sha1 = file($file)->slurp
             || confess("Error reading $file: $!");
         chomp $sha1;
-        return $self->ref_sha1($1) if $sha1 =~ /^ref: (.*)/;
-        return $sha1;
+        return _ensure_sha1_is_sha1( $self, $sha1 );
     }
 
     foreach my $file ( File::Find::Rule->new->file->in($dir) ) {
@@ -193,25 +192,36 @@ sub ref_sha1 {
             my $sha1 = file($file)->slurp
                 || confess("Error reading $file: $!");
             chomp $sha1;
-            return $self->ref_sha1($1) if $sha1 =~ /^ref: (.*)/;
-            return $sha1;
+            return _ensure_sha1_is_sha1( $self, $sha1 );
         }
     }
 
     my $packed_refs = file( $self->gitdir, 'packed-refs' );
     if ( -f $packed_refs ) {
+        my $last_name;
+        my $last_sha1;
         foreach my $line ( $packed_refs->slurp( chomp => 1 ) ) {
             next if $line =~ /^#/;
             my ( $sha1, my $name ) = split ' ', $line;
-            if ( $name eq $wantref ) {
-                return $self->ref_sha1($1) if $sha1 =~ /^ref: (.*)/;
-                return $sha1;
-            }
+            $sha1 =~ s/^\^//;
+            $name ||= $last_name;
+
+            return _ensure_sha1_is_sha1( $self, $last_sha1 ) if $last_name and $last_name eq $wantref and $name ne $wantref;
+
+            $last_name = $name;
+            $last_sha1 = $sha1;
         }
+        return _ensure_sha1_is_sha1( $self, $last_sha1 ) if $last_name eq $wantref;
     }
     return undef;
 }
 
+sub _ensure_sha1_is_sha1 {
+    my ( $self, $sha1 ) = @_;
+    return $self->ref_sha1($1) if $sha1 =~ /^ref: (.*)/;
+    return $sha1;
+}
+
 sub ref {
     my ( $self, $wantref ) = @_;
     return $self->get_object( $self->ref_sha1($wantref) );
@@ -556,4 +566,3 @@ This module is free software; you can redistribute it or
 modify it under the same terms as Perl itself.
 
 =cut
-

lib/Git/PurePerl/Loose.pm

@@ -20,9 +20,9 @@ sub get_object {
         = file( $self->directory, substr( $sha1, 0, 2 ), substr( $sha1, 2 ) );
     return unless -f $filename;
 
-    my $compressed = $filename->slurp;
+    my $compressed = $filename->slurp( iomode => '<:raw' );
     my $data       = uncompress($compressed);
-    my ( $kind, $size, $content ) = $data =~ /^(\w+) (\d+)\0(.+)$/s;
+    my ( $kind, $size, $content ) = $data =~ /^(\w+) (\d+)\0(.*)$/s;
     return ( $kind, $size, $content );
 }
 

lib/Git/PurePerl/NewObject.pm

@@ -13,7 +13,7 @@ has 'sha1'    => ( is => 'ro', isa => 'Str', required => 0, lazy_build => 1 );
 
 sub _build_sha1 {
     my $self = shift;
-    my $sha1 = Digest::SHA1->new;
+    my $sha1 = Digest::SHA->new;
     $sha1->add( $self->raw );
     my $sha1_hex = $sha1->hexdigest;
     return $sha1_hex;

lib/Git/PurePerl/Pack.pm

@@ -8,7 +8,8 @@ use namespace::autoclean;
 
 has 'filename' =>
     ( is => 'ro', isa => 'Path::Class::File', required => 1, coerce => 1 );
-has 'fh' => ( is => 'rw', isa => 'IO::File', required => 0 );
+has 'fh' =>
+    ( is => 'rw', isa => 'IO::File', required => 0, lazy_build => 1 );
 
 my @TYPES = ( 'none', 'commit', 'tree', 'blob', 'tag', '', 'ofs_delta',
     'ref_delta' );
@@ -22,11 +23,11 @@ my $OBJ_REF_DELTA = 7;
 
 my $SHA1Size = 20;
 
-sub BUILD {
+sub _build_fh {
     my $self = shift;
     my $fh = IO::File->new( $self->filename ) || confess($!);
     $fh->binmode();
-    $self->fh($fh);
+    return $fh;
 }
 
 sub all_sha1s {

lib/Git/PurePerl/Pack/WithoutIndex.pm

@@ -16,7 +16,7 @@ sub create_index {
     $index_filename =~ s/\.pack/.idx/;
     my $index_fh = IO::File->new("> $index_filename") || die $!;
 
-    my $iod = IO::Digest->new( $index_fh, 'SHA1' );
+    my $iod = IO::Digest->new( $index_fh, 'SHA' );
 
     my $offsets = $self->create_index_offsets;
     my @fan_out_table;
@@ -100,7 +100,7 @@ sub create_index_offsets {
         }
 
         my $raw  = $type . ' ' . $size . "\0" . $content;
-        my $sha1 = Digest::SHA1->new;
+        my $sha1 = Digest::SHA->new;
         $sha1->add($raw);
         my $sha1_hex = $sha1->hexdigest;
         $offsets{$sha1_hex} = $obj_offset;