view release on metacpan or  search on metacpan

lib/Cogit.pm  view on Meta::CPAN

   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");

   dir($git_dir, 'info')->mkpath;
   $class->_add_file(file($git_dir, 'info', 'exclude'), "# *.[oa]\n# *~\n");

   return $class->new(%arguments);
}

sub checkout {
   my ($self, $directory, $tree) = @_;
   $directory ||= $self->directory;
   $tree ||= $self->master->tree;
   confess("Missing tree") unless $tree;
   for my $directory_entry (@{$tree->directory_entries}) {
      my $filename = file($directory, $directory_entry->filename);
      my $sha1     = $directory_entry->sha1;
      my $mode     = $directory_entry->mode;
      my $object   = $self->get_object($sha1);
      if ($object->kind eq 'blob') {
         $self->_add_file($filename, $object->content);
         chmod(oct('0' . $mode), $filename)
           || die "Error chmoding $filename to $mode: $!";
      } elsif ($object->kind eq 'tree') {
         dir($filename)->mkpath;
         $self->checkout($filename, $object);
      } else {
         die $object->kind;
      }
   }
}

sub clone {
   my $self = shift;

   my $remote;
   if (@_ == 2) {

      # For backwards compatibility
      $remote = "git://$_[0]";
      $remote .= "/" unless $_[1] =~ m{^/};
      $remote .= $_[1];
   } else {
      $remote = shift;
   }

   my $protocol = Cogit::Protocol->new(remote => $remote)->connect;

   my $sha1s = $protocol->fetch;
   my $head  = $sha1s->{HEAD};
   my $data  = $protocol->fetch_pack($head);

   my $filename =
     file($self->gitdir, 'objects', 'pack', 'pack-' . $head . '.pack');
   $self->_add_file($filename, $data);

   my $pack = Cogit::Pack::WithoutIndex->new(filename => $filename);
   $pack->create_index();

   $self->update_ref(master => $head);
}

sub _add_file {
   my ($class, $filename, $contents) = @_;
   my $fh = $filename->openw || confess "Error opening to $filename: $!";
   binmode($fh);    #important for Win32
   $fh->print($contents) || confess "Error writing to $filename: $!";
   $fh->close || confess "Error closing $filename: $!";
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Cogit - A truly Pure Perl interface to Git repositories

=head1 VERSION