@@ -1,5 +1,9 @@ Revision history for Perl module Git::PurePerl: +0.42 + - allow put_object to update other heads than just 'master' + (thanks to martijn) + 0.41 Tue Apr 21 20:41:07 BST 2009 - allow subdirectories in .git/refs/*/ (thanks to martijn) - run protocol.t test with --base-path to not care about where CHANGES @@ -295,23 +295,26 @@ sub all_objects { } sub put_object { - my ( $self, $object ) = @_; + my ( $self, $object, $ref ) = @_; $self->loose->put_object($object); if ( $object->kind eq 'commit' ) { - $self->update_master( $object->sha1 ); + $ref = 'master' unless $ref; + $self->update_ref( $ref, $object->sha1 ); } } -sub update_master { - my ( $self, $sha1 ) = @_; - my $master = file( $self->gitdir, 'refs', 'heads', 'master' ); - $master->parent->mkpath; - my $master_fh = $master->openw; - $master_fh->print($sha1) || die "Error writing to $master"; +sub update_ref { + my ( $self, $refname, $sha1 ) = @_; + my $ref = file( $self->gitdir, 'refs', 'heads', $refname ); + $ref->parent->mkpath; + my $ref_fh = $ref->openw; + $ref_fh->print($sha1) || die "Error writing to $ref"; + + # FIXME is this always what we want? my $head = file( $self->gitdir, 'HEAD' ); my $head_fh = $head->openw; - $head_fh->print('ref: refs/heads/master') + $head_fh->print("ref: refs/heads/$refname") || die "Error writing to $head"; } @@ -417,7 +420,7 @@ sub clone { = Git::PurePerl::Pack::WithoutIndex->new( filename => $filename ); $pack->create_index(); - $self->update_master($head); + $self->update_ref( master => $head ); } sub _add_file { lib/Git/PurePerl.pm 586199f673641498ca51cf1a83a83b0bc6fddac9 Leon Brocard acme@astray.com http://github.com/acme/git-pureperl/commit/4642624c353903a4508b5c79e142c01597da9a82 4642624c353903a4508b5c79e142c01597da9a82 2009-04-23T09:02:08-07:00 2009-04-23T09:02:08-07:00 allow put_object to update other heads than just 'master' (thanks to martijn) 0fa5ae99cd83a4a223e63cb4c4b05f7f39a4ccce Leon Brocard acme@astray.com