view release on metacpan or  search on metacpan

lib/CPAN/InGit/MutableTree.pm  view on Meta::CPAN

      }
   }
   if ($self->tree) {
      my $dirent= $self->tree->entry_bypath($path)
         or return undef;
      return [ $dirent->object, $dirent->file_mode ];
   }      
   return undef;
}


sub set_path($self, $path, $data, %opts) {
   # Two modes: we can be writing to the working directory and index, or be building a new tree
   # (which may or may not be connected to a branch)
   my $repo= $self->git_repo;
   my $mode= $opts{mode} // 0100644;
   my @path= split m{/+}, $path;
   my $basename= pop @path;
   if ($self->use_workdir) {
      my $fullpath= $self->git_repo->workdir;
      # create missing directories
      for (@path) {
         $fullpath .= '/'.$_;
         mkdir $fullpath || die "mkdir($fullpath): $!"
            unless -d $fullpath;
      }
      $fullpath .= '/'.$basename;
      if (!defined $data) {
         unlink($fullpath);
         $self->git_repo->index->remove($path);
      } else {
         # a shame there's no way to add the blob directly...
         $data= \$data->content if ref($data)->isa('Git::Raw::Blob');
         # Write file
         _mkfile($fullpath, $data, $mode);
         # Add to the index
         $self->git_repo->index->add_frombuffer($path, $data, $mode);
      }
   }
   else {
      my $node= ($self->{_changes} //= {});
      for (@path) {
         $node= ($node->{$_} //= {});
         ref $node eq 'HASH' or die "Can't set '$path'; '$_' is not a directory";
      }
      # Content may either be a Blob object or a scalar-ref of bytes
      if (ref $data eq 'SCALAR') {
         $data= Git::Raw::Blob->create($repo, $$data);
      }
      $node->{$basename}= defined $data? [ $data, $mode ] : undef;
   }
   $self->has_changes(1);
   $self->{_changes} //= {};
   $self;
}

sub _mkfile($path, $scalarref, $mode) {
   open my $fh, '>', $path or die "open($path): $!";
   $fh->print($$scalarref) or die "write($path): $!";
   $fh->close or die "close($path): $!";
   chmod($path, $mode) || die "chmod($path, $mode): $!"
      if defined $mode && $mode != 0100644;
}


sub update_tree($self) {
   # If using the Index, the index can write the new tree
   if ($self->use_workdir) {
      $self->tree($self->git_repo->index->write_tree);
   } else {
      $self->tree(_assemble_tree($self->git_repo, $self->tree, $self->_changes));
      $self->_changes({}); # reset the changes hash
   }
   # don't reset has_changes until it has been committed
}

# merge a hashref of changes into the previous Tree, and return the new Tree
# Changes look like:
#  {
#     "path1" => {
#        "filename" => [ $blob, $mode ],
#        "fname2"   => [ $blob, $mode ],
#     }
#  }
sub _assemble_tree($repo, $tree, $changes) {
   my $treebuilder= Git::Raw::Tree::Builder->new($repo, ($tree? ($tree) : ()));
   for my $name (keys %$changes) {
      my $ent= $changes->{$name};
      if (!defined $ent) {
         $treebuilder->remove($name);
      }
      else {
         if (ref $ent eq 'HASH') { # a subdirectory
            my $dirent= $treebuilder->get($name);
            my $subdir= $dirent && $dirent->type == Git::Raw::Object::TREE()
               ? Git::Raw::Tree->lookup($repo, $dirent->id) : undef;
            $ent= [ _assemble_tree($repo, $subdir, $ent), 0040000 ];
         }
         $treebuilder->insert($name, @$ent);
      }
   }
   return $treebuilder->write; # returns Git::Raw::Tree
}


sub commit($self, $message, %opts) {
   croak "No changes added" unless $self->has_changes;
   my $repo= $self->git_repo;
   $self->update_tree;
   my $branch= $self->branch;
   my $cur_sig= $self->parent->new_signature;
   my $author= $opts{author} // $cur_sig;
   my $update_head= $self->use_workdir // $opts{update_head};
   my $committer= $opts{committer} // $cur_sig;
   my $parents= $self->use_workdir? (
                  # dies on new repo if HEAD doesn't exist yet, in which case no parents
                  eval { [ $self->git_repo->head->target ] } || []
                )
              : $branch? [ $self->branch->peel('commit') ]
              : length $opts{create_branch}? [] # fresh branch, no parent commit
              : croak "Can't commit without a branch or use_workdir or option create_branch";