@@ -39,6 +39,10 @@ $VERSION = '0.01';
3939 my $lastrev = $repo->command_oneline( [ 'rev-list', '--all' ],
4040 STDERR => 0 );
4141
42+ my $sha1 = $repo->hash_and_insert_object('file.txt');
43+ my $tempfile = tempfile();
44+ my $size = $repo->cat_blob($sha1, $tempfile);
45+
4246=cut
4347
4448
@@ -218,7 +222,6 @@ sub repository {
218222 bless $self , $class ;
219223}
220224
221-
222225=back
223226
224227=head1 METHODS
@@ -734,6 +737,147 @@ sub hash_object {
734737}
735738
736739
740+ =item hash_and_insert_object ( FILENAME )
741+
742+ Compute the SHA1 object id of the given C<FILENAME > and add the object to the
743+ object database.
744+
745+ The function returns the SHA1 hash.
746+
747+ =cut
748+
749+ # TODO: Support for passing FILEHANDLE instead of FILENAME
750+ sub hash_and_insert_object {
751+ my ($self , $filename ) = @_ ;
752+
753+ carp " Bad filename \" $filename \" " if $filename =~ / [\r\n ]/ ;
754+
755+ $self -> _open_hash_and_insert_object_if_needed();
756+ my ($in , $out ) = ($self -> {hash_object_in }, $self -> {hash_object_out });
757+
758+ unless (print $out $filename , " \n " ) {
759+ $self -> _close_hash_and_insert_object();
760+ throw Error::Simple(" out pipe went bad" );
761+ }
762+
763+ chomp (my $hash = <$in >);
764+ unless (defined ($hash )) {
765+ $self -> _close_hash_and_insert_object();
766+ throw Error::Simple(" in pipe went bad" );
767+ }
768+
769+ return $hash ;
770+ }
771+
772+ sub _open_hash_and_insert_object_if_needed {
773+ my ($self ) = @_ ;
774+
775+ return if defined ($self -> {hash_object_pid });
776+
777+ ($self -> {hash_object_pid }, $self -> {hash_object_in },
778+ $self -> {hash_object_out }, $self -> {hash_object_ctx }) =
779+ command_bidi_pipe(qw( hash-object -w --stdin-paths) );
780+ }
781+
782+ sub _close_hash_and_insert_object {
783+ my ($self ) = @_ ;
784+
785+ return unless defined ($self -> {hash_object_pid });
786+
787+ my @vars = map { ' hash_object_' . $_ } qw( pid in out ctx) ;
788+
789+ command_close_bidi_pipe($self -> {@vars });
790+ delete $self -> {@vars };
791+ }
792+
793+ =item cat_blob ( SHA1, FILEHANDLE )
794+
795+ Prints the contents of the blob identified by C<SHA1 > to C<FILEHANDLE > and
796+ returns the number of bytes printed.
797+
798+ =cut
799+
800+ sub cat_blob {
801+ my ($self , $sha1 , $fh ) = @_ ;
802+
803+ $self -> _open_cat_blob_if_needed();
804+ my ($in , $out ) = ($self -> {cat_blob_in }, $self -> {cat_blob_out });
805+
806+ unless (print $out $sha1 , " \n " ) {
807+ $self -> _close_cat_blob();
808+ throw Error::Simple(" out pipe went bad" );
809+ }
810+
811+ my $description = <$in >;
812+ if ($description =~ / missing$ / ) {
813+ carp " $sha1 doesn't exist in the repository" ;
814+ return 0;
815+ }
816+
817+ if ($description !~ / ^[0-9a-fA-F]{40} \S + (\d +)$ / ) {
818+ carp " Unexpected result returned from git cat-file" ;
819+ return 0;
820+ }
821+
822+ my $size = $1 ;
823+
824+ my $blob ;
825+ my $bytesRead = 0;
826+
827+ while (1) {
828+ my $bytesLeft = $size - $bytesRead ;
829+ last unless $bytesLeft ;
830+
831+ my $bytesToRead = $bytesLeft < 1024 ? $bytesLeft : 1024;
832+ my $read = read ($in , $blob , $bytesToRead , $bytesRead );
833+ unless (defined ($read )) {
834+ $self -> _close_cat_blob();
835+ throw Error::Simple(" in pipe went bad" );
836+ }
837+
838+ $bytesRead += $read ;
839+ }
840+
841+ # Skip past the trailing newline.
842+ my $newline ;
843+ my $read = read ($in , $newline , 1);
844+ unless (defined ($read )) {
845+ $self -> _close_cat_blob();
846+ throw Error::Simple(" in pipe went bad" );
847+ }
848+ unless ($read == 1 && $newline eq " \n " ) {
849+ $self -> _close_cat_blob();
850+ throw Error::Simple(" didn't find newline after blob" );
851+ }
852+
853+ unless (print $fh $blob ) {
854+ $self -> _close_cat_blob();
855+ throw Error::Simple(" couldn't write to passed in filehandle" );
856+ }
857+
858+ return $size ;
859+ }
860+
861+ sub _open_cat_blob_if_needed {
862+ my ($self ) = @_ ;
863+
864+ return if defined ($self -> {cat_blob_pid });
865+
866+ ($self -> {cat_blob_pid }, $self -> {cat_blob_in },
867+ $self -> {cat_blob_out }, $self -> {cat_blob_ctx }) =
868+ command_bidi_pipe(qw( cat-file --batch) );
869+ }
870+
871+ sub _close_cat_blob {
872+ my ($self ) = @_ ;
873+
874+ return unless defined ($self -> {cat_blob_pid });
875+
876+ my @vars = map { ' cat_blob_' . $_ } qw( pid in out ctx) ;
877+
878+ command_close_bidi_pipe($self -> {@vars });
879+ delete $self -> {@vars };
880+ }
737881
738882=back
739883
@@ -951,7 +1095,11 @@ sub _cmd_close {
9511095}
9521096
9531097
954- sub DESTROY { }
1098+ sub DESTROY {
1099+ my ($self ) = @_ ;
1100+ $self -> _close_hash_and_insert_object();
1101+ $self -> _close_cat_blob();
1102+ }
9551103
9561104
9571105# Pipe implementation for ActiveState Perl.
0 commit comments