perl/Git/Repo.pm

   1 =head1 NAME
   2
   3 Git::Repo - Read-only access to the Git repositories.
   4
   5 =head1 DESCRIPTION
   6
   7 Git::Repo aims to provide low-level access to Git repositories.  For
   8 instance, you can resolve object names (like 'HEAD~2') to SHA1s, and
   9 inspect objects.  It does not attempt to be a wrapper around the git
  10 plumbing or porcelain commands.
  11
  12 Error handling is simple: On a consistent repository, the Perl
  13 interface will never die.  You can use the get_sha1 method to resolve
  14 arbitrary object names or check the existence of SHA1 hashes; get_sha1
  15 will return undef if the object does not exist in the repository.  Any
  16 SHA1 that is returned by get_sha1 can be safely passed to the other
  17 Git::Repo methods.
  18
  19 =head1 SYNOPSIS
  20
  21   use Git::Repo;
  22
  23   my $repo = Git::Repo->new(
  24       repo_dir => '/path/to/repository.git',
  25       git_binary => '/usr/bin/git');
  26   my $sha1 = $repo->get_sha1('HEAD');
  27   print "Last log message:\n\n" . $repo->get_commit($sha1)->message;
  28
  29 =cut
  30
  31
  32 use strict;
  33 use warnings;
  34 # We could be compatible to Perl 5.6, but it doesn't provide sane pipe
  35 # handling (sane meaning does not go through shell, and allows for
  36 # accessing the exit code), so we require 5.8 until someone decides to
  37 # implement fork/exec-based pipe handling, plus possibly workarounds
  38 # for Windows brokenness.
  39 use 5.008;
  40
  41
  42 package Git::Repo;
  43
  44 use Git::Tag;
  45 use Git::Commit;
  46
  47 use IPC::Open2 qw(open2);
  48 use IO::Handle;
  49
  50 use base qw(Exporter);
  51
  52 our @EXPORT = qw();
  53 our @EXPORT_OK = qw();
  54
  55 # Auxiliary subroutines
  56
  57 sub _assert_opts {
  58         die "must have an even number of arguments for named options"
  59             unless $#_ % 2;
  60 }
  61
  62 sub _assert_sha1 {
  63         my $sha1 = shift;
  64         die "'$sha1' is not a SHA1 (need to use get_sha1?)"
  65             unless $sha1 && $sha1 =~ /^[a-f0-9]{40}$/;
  66 }
  67
  68
  69 =head1 METHODS
  70
  71 =head2 General methods
  72
  73 =over
  74
  75 =item $repo = Git::Repo->new(%opts)
  76
  77 Return a new Git::Repo object.  The following options are supported:
  78
  79 =over
  80
  81 =item 'repo_dir'
  82
  83 The directory of the repository (mandatory).
  84
  85 Note that this option is working-copy agnostic; you need to
  86 instantiate it with the working copy's .git directory as the
  87 'repo_dir' option.
  88
  89 =item 'git_binary'
  90
  91 The name or full path of the git binary (default: 'git').
  92
  93 =back
  94
  95 Calling this method is free, since it does not check whether the
  96 repository exists.  Trying to access the repository through one of the
  97 instance methods will fail if it doesn't exist though.
  98
  99 Examples:
 100
 101     $repo = Git::Repo->new(repo_dir => '/path/to/repository.git');
 102     $repo = Git::Repo->new(repo_dir => '/path/to/working_copy/.git');
 103
 104 =cut
 105
 106 sub new {
 107         my $class = shift;
 108         _assert_opts @_;
 109         my $self = {@_};
 110         bless $self, $class;
 111         die 'no repo_dir given' unless $self->{repo_dir};
 112         return $self;
 113 }
 114
 115 =item $repo->repo_dir
 116
 117 Return the directory of the repository (.../.git in case of a working
 118 copy).
 119
 120 =cut
 121
 122 sub repo_dir {
 123         shift->{repo_dir}
 124 }
 125
 126 =item $repo->git_binary
 127
 128 Return the name of or path to the git binary (used with exec).
 129
 130 =cut
 131
 132 sub git_binary {
 133         shift->{git_binary}
 134 }
 135
 136 # Return the first items of the git command line, for instance
 137 # qw(/usr/bin/git --git-dir=/path/to/repo.git).
 138 sub _git_cmd {
 139         my $self = shift;
 140         return ($self->git_binary || 'git', '--git-dir=' . $self->repo_dir);
 141 }
 142
 143
 144 =back
 145
 146 =head2 Inspecting the repository
 147
 148 =over
 149
 150 =item $repo->get_sha1($extended_object_identifier)
 151
 152 Look up the object identified by $extended_object_identifier and
 153 return its SHA1 hash in scalar context or its ($sha1, $type, $size) in
 154 list context, or undef or () if the lookup failed, where $type is one
 155 of 'tag', 'commit', 'tree', or 'blob'.
 156
 157 See L<git-rev-parse(1)>, section "Specifying Revisions", for the
 158 syntax of the $extended_object_identifier string.
 159
 160 Note that even if you pass a SHA1 hash, its existence is still
 161 checked, and this method returns undef or () if it doesn't exist in
 162 the repository.
 163
 164 =cut
 165
 166 sub get_sha1 {
 167         my ($self, $object_id) = @_;
 168         die 'no object identifier given' unless $object_id;
 169         die 'object identifier must not contain newlines' if $object_id =~ /\n/;
 170         unless ($self->{sha1_stdout}) {
 171                 # Open bidi pipe the first time get_sha1 is called.
 172                 # open2 raises an exception on error, no need to 'or die'.
 173                 open2($self->{sha1_stdout}, $self->{sha1_stdin},
 174                       $self->_git_cmd, 'cat-file', '--batch-check');
 175         }
 176         $self->{sha1_stdin}->print("$object_id\n")
 177             or die 'cannot write to pipe';
 178         my $output = $self->{sha1_stdout}->getline
 179             or die 'cannot read from pipe';
 180         chomp $output;
 181         return if $output =~ /missing$/;
 182         my ($sha1, $type, $size) =
 183             ($output =~ /^([0-9a-f]{40}) ([a-z]+) ([0-9]+)$/)
 184             or die "invalid response: $output";
 185         return wantarray ? ($sha1, $type, $size) : $sha1;
 186 }
 187
 188 =item $repo->get_object($sha1)
 189
 190 Return the content (as a string) of the object identified by $sha1, or
 191 die if no such object exists in the repository.  In list context,
 192 return the ($type, $content) of the object.
 193
 194 Note that you may want to use the higher-level methods get_commit and
 195 get_tag instead.
 196
 197 =cut
 198
 199 # Possible to-do items: Add optional $file_handle parameter.  Guard
 200 # against getting huge blobs back when we don't expect it (for
 201 # instance, we could limit the size and send SIGPIPE to git if we get
 202 # a blob that is too large).
 203
 204 sub get_object {
 205         my ($self, $sha1) = @_;
 206         _assert_sha1($sha1);
 207
 208         unless ($self->{object_stdout}) {
 209                 # Open bidi pipe the first time get_object is called.
 210                 # open2 raises an exception on error, no need to 'or die'.
 211                 open2($self->{object_stdout}, $self->{object_stdin},
 212                       $self->_git_cmd, 'cat-file', '--batch');
 213         }
 214         $self->{object_stdin}->print("$sha1\n") or die 'cannot write to pipe';
 215         my ($ret_sha1, $type, $size) =
 216             split ' ', $self->{object_stdout}->getline
 217             or die 'cannot read from pipe';
 218         die "'$sha1' not found in repository" if $type eq 'missing';
 219         $self->{object_stdout}->read(my $content, $size);
 220         $self->{object_stdout}->getline;  # eat trailing newline
 221         return wantarray ? ($type, $content) : $content;
 222 }
 223
 224 =item $repo->get_commit($commit_sha1)
 225
 226 Return a new L<Git::Commit> instance referring to the commit object
 227 with SHA1 $commit_sha1.
 228
 229 =cut
 230
 231 sub get_commit {
 232         my ($self, $sha1) = @_;
 233         _assert_sha1($sha1);
 234         return Git::Commit->new($self, $sha1);
 235 }
 236
 237 =item $repo->get_tag($tag_sha1)
 238
 239 Return a new L<Git::Tag> instance referring to the tag object with SHA1
 240 $tag_sha1.
 241
 242 =cut
 243
 244 sub get_tag {
 245         my ($self, $sha1) = @_;
 246         _assert_sha1($sha1);
 247         return Git::Tag->new($self, $sha1);
 248 }
 249
 250 =item $repo->name_rev($committish_sha1, $tags_only = 0)
 251
 252 Return a symbolic name for the commit identified by $committish_sha1,
 253 or undef if no name can be found; see L<git-name-rev(1)> for details.
 254 If $tags_only is true, no branch names are used to name the commit.
 255
 256 =cut
 257
 258 sub name_rev {
 259         my ($self, $sha1, $tags_only) = @_;
 260         _assert_sha1($sha1);
 261
 262         # Note that we cannot use a bidi pipe here since name git
 263         # name-rev --stdin has an excessively high start-up time.
 264         # http://thread.gmane.org/gmane.comp.version-control.git/85531
 265         open my $fh, '-|', $self->_git_cmd, 'name-rev',
 266                 $tags_only ? '--tags' : (), '--name-only', $sha1
 267             or die 'error calling git binary';
 268         chomp(my $name = <$fh>);
 269         close $fh or die 'git name-rev returned an unexpected error';
 270         return $name eq 'undefined' ? undef : $name;
 271 }
 272
 273
 274 1;