--- /dev/null
+package Git::PurePerl::Pack;
+use Moose;
+use MooseX::StrictConstructor;
+use MooseX::Types::Path::Class;
+use Compress::Raw::Zlib;
+use IO::File;
+use namespace::autoclean;
+
+has 'filename' =>
+ ( is => 'ro', isa => 'Path::Class::File', required => 1, coerce => 1 );
+has 'fh' => ( is => 'rw', isa => 'IO::File', required => 0 );
+
+my @TYPES = ( 'none', 'commit', 'tree', 'blob', 'tag', '', 'ofs_delta',
+ 'ref_delta' );
+my $OBJ_NONE = 0;
+my $OBJ_COMMIT = 1;
+my $OBJ_TREE = 2;
+my $OBJ_BLOB = 3;
+my $OBJ_TAG = 4;
+my $OBJ_OFS_DELTA = 6;
+my $OBJ_REF_DELTA = 7;
+
+my $SHA1Size = 20;
+
+sub BUILD {
+ my $self = shift;
+ my $fh = IO::File->new( $self->filename ) || confess($!);
+ $fh->binmode();
+ $self->fh($fh);
+}
+
+sub all_sha1s {
+ my ( $self, $want_sha1 ) = @_;
+ return Data::Stream::Bulk::Array->new(
+ array => [ $self->index->all_sha1s ] );
+}
+
+sub unpack_object {
+ my ( $self, $offset ) = @_;
+ my $obj_offset = $offset;
+ my $fh = $self->fh;
+
+ $fh->seek( $offset, 0 ) || die "Error seeking in pack: $!";
+ $fh->read( my $c, 1 ) || die "Error reading from pack: $!";
+ $c = unpack( 'C', $c ) || die $!;
+
+ my $size = ( $c & 0xf );
+ my $type_number = ( $c >> 4 ) & 7;
+ my $type = $TYPES[$type_number] || confess "invalid type $type_number";
+
+ my $shift = 4;
+ $offset++;
+
+ while ( ( $c & 0x80 ) != 0 ) {
+ $fh->read( $c, 1 ) || die $!;
+ $c = unpack( 'C', $c ) || die $!;
+ $size |= ( ( $c & 0x7f ) << $shift );
+ $shift += 7;
+ $offset += 1;
+ }
+
+ if ( $type eq 'ofs_delta' || $type eq 'ref_delta' ) {
+ ( $type, $size, my $content )
+ = $self->unpack_deltified( $type, $offset, $obj_offset, $size );
+ return ( $type, $size, $content );
+
+ } elsif ( $type eq 'commit'
+ || $type eq 'tree'
+ || $type eq 'blob'
+ || $type eq 'tag' )
+ {
+ my $content = $self->read_compressed( $offset, $size );
+ return ( $type, $size, $content );
+ } else {
+ confess "invalid type $type";
+ }
+}
+
+sub read_compressed {
+ my ( $self, $offset, $size ) = @_;
+ my $fh = $self->fh;
+
+ $fh->seek( $offset, 0 ) || die $!;
+ my ( $deflate, $status ) = Compress::Raw::Zlib::Inflate->new(
+ -AppendOutput => 1,
+ -ConsumeInput => 0
+ );
+
+ my $out = "";
+ while ( length($out) < $size ) {
+ $fh->read( my $block, 4096 ) || die $!;
+ my $status = $deflate->inflate( $block, $out );
+ }
+ confess length($out)." is not $size" unless length($out) == $size;
+
+ $fh->seek( $offset + $deflate->total_in, 0 ) || die $!;
+ return $out;
+}
+
+sub unpack_deltified {
+ my ( $self, $type, $offset, $obj_offset, $size ) = @_;
+ my $fh = $self->fh;
+
+ my $base;
+
+ $fh->seek( $offset, 0 ) || die $!;
+ $fh->read( my $data, $SHA1Size ) || die $!;
+ my $sha1 = unpack( 'H*', $data );
+
+ if ( $type eq 'ofs_delta' ) {
+ my $i = 0;
+ my $c = unpack( 'C', substr( $data, $i, 1 ) );
+ my $base_offset = $c & 0x7f;
+
+ while ( ( $c & 0x80 ) != 0 ) {
+ $c = unpack( 'C', substr( $data, ++$i, 1 ) );
+ $base_offset++;
+ $base_offset <<= 7;
+ $base_offset |= $c & 0x7f;
+ }
+ $base_offset = $obj_offset - $base_offset;
+ $offset += $i + 1;
+
+ ( $type, undef, $base ) = $self->unpack_object($base_offset);
+ } else {
+ ( $type, undef, $base ) = $self->get_object($sha1);
+ $offset += $SHA1Size;
+
+ }
+
+ my $delta = $self->read_compressed( $offset, $size );
+ my $new = $self->patch_delta( $base, $delta );
+
+ return ( $type, length($new), $new );
+}
+
+sub patch_delta {
+ my ( $self, $base, $delta ) = @_;
+
+ my ( $src_size, $pos ) = $self->patch_delta_header_size( $delta, 0 );
+ if ( $src_size != length($base) ) {
+ confess "invalid delta data";
+ }
+
+ ( my $dest_size, $pos ) = $self->patch_delta_header_size( $delta, $pos );
+ my $dest = "";
+
+ while ( $pos < length($delta) ) {
+ my $c = substr( $delta, $pos, 1 );
+ $c = unpack( 'C', $c );
+ $pos++;
+ if ( ( $c & 0x80 ) != 0 ) {
+
+ my $cp_off = 0;
+ my $cp_size = 0;
+ $cp_off = unpack( 'C', substr( $delta, $pos++, 1 ) )
+ if ( $c & 0x01 ) != 0;
+ $cp_off |= unpack( 'C', substr( $delta, $pos++, 1 ) ) << 8
+ if ( $c & 0x02 ) != 0;
+ $cp_off |= unpack( 'C', substr( $delta, $pos++, 1 ) ) << 16
+ if ( $c & 0x04 ) != 0;
+ $cp_off |= unpack( 'C', substr( $delta, $pos++, 1 ) ) << 24
+ if ( $c & 0x08 ) != 0;
+ $cp_size = unpack( 'C', substr( $delta, $pos++, 1 ) )
+ if ( $c & 0x10 ) != 0;
+ $cp_size |= unpack( 'C', substr( $delta, $pos++, 1 ) ) << 8
+ if ( $c & 0x20 ) != 0;
+ $cp_size |= unpack( 'C', substr( $delta, $pos++, 1 ) ) << 16
+ if ( $c & 0x40 ) != 0;
+ $cp_size = 0x10000 if $cp_size == 0;
+
+ $dest .= substr( $base, $cp_off, $cp_size );
+ } elsif ( $c != 0 ) {
+ $dest .= substr( $delta, $pos, $c );
+ $pos += $c;
+ } else {
+ confess 'invalid delta data';
+ }
+ }
+
+ if ( length($dest) != $dest_size ) {
+ confess 'invalid delta data';
+ }
+ return $dest;
+}
+
+sub patch_delta_header_size {
+ my ( $self, $delta, $pos ) = @_;
+
+ my $size = 0;
+ my $shift = 0;
+ while (1) {
+
+ my $c = substr( $delta, $pos, 1 );
+ unless ( defined $c ) {
+ confess 'invalid delta header';
+ }
+ $c = unpack( 'C', $c );
+
+ $pos++;
+ $size |= ( $c & 0x7f ) << $shift;
+ $shift += 7;
+ last if ( $c & 0x80 ) == 0;
+ }
+ return ( $size, $pos );
+}
+
+__PACKAGE__->meta->make_immutable;
+
projects / catagits/Gitalist.git / blobdiff