view release on metacpan or  search on metacpan

lib/Cogit.pm  view on Meta::CPAN

         sha1    => $sha1,
         kind    => $kind,
         size    => $size,
         content => $content,
         git     => $self,
      );
   } elsif ($kind eq 'blob') {
      return Cogit::Object::Blob->new(
         sha1    => $sha1,
         kind    => $kind,
         size    => $size,
         content => $content,
         git     => $self,
      );
   } elsif ($kind eq 'tag') {
      return Cogit::Object::Tag->new(
         sha1    => $sha1,
         kind    => $kind,
         size    => $size,
         content => $content,
         git     => $self,
      );
   } else {
      confess "unknown kind $kind: $content";
   }
}

sub all_sha1s {
   my $self = shift;
   my $dir = dir($self->gitdir, 'objects');

   my @streams;
   push @streams, $self->loose->all_sha1s;

   for my $pack (@{$self->packs}) {
      push @streams, $pack->all_sha1s;
   }

   return Data::Stream::Bulk::Cat->new(streams => \@streams);
}

sub all_objects {
   my $self   = shift;
   my $stream = $self->all_sha1s;
   return Data::Stream::Bulk::Filter->new(
      filter => sub { return [$self->get_objects(@$_)] },
      stream => $stream,
   );
}

sub put_object {
   my ($self, $object, $ref) = @_;
   $self->loose->put_object($object);

   if ($object->kind eq 'commit') {
      $ref = 'master' unless $ref;
      $self->update_ref($ref, $object->sha1);
   }
}

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/$refname")
     || die "Error writing to $head";
}

sub init {
   my ($class, %arguments) = @_;

   my $directory = $arguments{directory};
   my $git_dir;

   unless (defined $directory) {
      $git_dir = $arguments{gitdir}
        || confess "init() needs either a 'directory' or a 'gitdir' argument";
   } else {
      if (not defined $arguments{gitdir}) {
         $git_dir = $arguments{gitdir} = dir($directory, '.git');
      }
      dir($directory)->mkpath;
   }

   dir($git_dir)->mkpath;
   dir($git_dir, 'refs',    'tags')->mkpath;
   dir($git_dir, 'objects', 'info')->mkpath;
   dir($git_dir, 'objects', 'pack')->mkpath;
   dir($git_dir, 'branches')->mkpath;
   dir($git_dir, 'hooks')->mkpath;

   my $bare = defined($directory) ? 'false' : 'true';
   $class->_add_file(
      file($git_dir, 'config'),
      "[core]\n\trepositoryformatversion = 0\n\tfilemode = true\n\tbare = $bare\n\tlogallrefupdates = true\n"
   );
   $class->_add_file(file($git_dir, 'description'),
      "Unnamed repository; edit this file to name it for gitweb.\n");
   $class->_add_file(file($git_dir, 'hooks', 'applypatch-msg'),
      "# add shell script and make executable to enable\n");
   $class->_add_file(file($git_dir, 'hooks', 'post-commit'),
      "# add shell script and make executable to enable\n");
   $class->_add_file(file($git_dir, 'hooks', 'post-receive'),
      "# add shell script and make executable to enable\n");
   $class->_add_file(file($git_dir, 'hooks', 'post-update'),
      "# add shell script and make executable to enable\n");
   $class->_add_file(file($git_dir, 'hooks', 'pre-applypatch'),
      "# add shell script and make executable to enable\n");
   $class->_add_file(file($git_dir, 'hooks', 'pre-commit'),
      "# add shell script and make executable to enable\n");
   $class->_add_file(file($git_dir, 'hooks', 'pre-rebase'),
      "# add shell script and make executable to enable\n");
   $class->_add_file(file($git_dir, 'hooks', 'update'),
      "# add shell script and make executable to enable\n");