From 237d4dcfed36731032f910278f942b1ebe80a074 Mon Sep 17 00:00:00 2001 From: Lea Wiemann Date: Wed, 4 Jun 2008 01:47:25 +0200 Subject: [PATCH] add new Perl API: Git::Repo, Git::Commit, Git::Tag, and Git::RepoRoot The Git::Repo class provides low-level access to Git repositories. The Git::Commit and Git::Tag classes represent commit and tag objects and allow for accessing their respective properties (like 'author', 'tagger', etc.); Git::Object serves as a common base class for them. Git::RepoRoot is a helper factory class to instantiate Git::Repo objects with common properties for repositories under a common root directory. Signed-off-by: Lea Wiemann --- perl/Git/Commit.pm | 179 +++++++++++++++++++++++++++++++ perl/Git/Object.pm | 94 ++++++++++++++++ perl/Git/Repo.pm | 274 +++++++++++++++++++++++++++++++++++++++++++++++ perl/Git/RepoRoot.pm | 103 ++++++++++++++++++ perl/Git/Tag.pm | 169 +++++++++++++++++++++++++++++ perl/Makefile | 1 + perl/Makefile.PL | 10 +- t/t9710-perl-git-repo.sh | 49 +++++++++ t/t9710/test.pl | 136 +++++++++++++++++++++++ 9 files changed, 1014 insertions(+), 1 deletion(-) create mode 100644 perl/Git/Commit.pm create mode 100644 perl/Git/Object.pm create mode 100644 perl/Git/Repo.pm create mode 100644 perl/Git/RepoRoot.pm create mode 100644 perl/Git/Tag.pm create mode 100755 t/t9710-perl-git-repo.sh create mode 100755 t/t9710/test.pl diff --git a/perl/Git/Commit.pm b/perl/Git/Commit.pm new file mode 100644 index 0000000000..ee87e118c1 --- /dev/null +++ b/perl/Git/Commit.pm @@ -0,0 +1,179 @@ +=head1 NAME + +Git::Commit - Object-oriented interface to Git commit objects. + +=head1 DESCRIPTION + +Git::Commit is a class representing a commit object in a Git +repository. It stringifies to the commit object's SHA1. + +=cut + +use strict; +use warnings; + + +package Git::Commit; + +use base qw(Git::Object); + + +# Keep documentation in one place to save space. + +=head1 METHODS + +=head2 General Methods + +=over + +=item $commit = Git::Commit->new($repo, $sha1) + +Return a new Git::Commit instance for a commit object with $sha1 in +repository $repo. + +The commit object is loaded lazily. Hence, calls to this method are +free, and it does not check whether $sha1 exists and has the right +type. However, accessing any of the commit object's properties will +fail if $sha1 is not a valid commit object. + +Note that $sha1 must be the SHA1 of a commit object; tag objects are +not dereferenced. + +The author, committer and message methods return Unicode strings, +decoded according to the "encoding" header, with UTF-8 and then +Latin-1 as fallbacks. (These Unicode strings can contain code points +greater than 256 and are *not* UTF-8 strings; see man perlunitut on +how Perl handles Unicode.) + +You will usually want to call $repo->get_commit($sha1) instead of +instantiating this class directly; see L. + +=item $obj->repo + +Return the Git::Repo instance this object was instantiated with. + +=item $obj->sha1 + +Return the SHA1 of this commit object, as provided at instantiation time. + +=back + +=head2 Property Methods + +Calling any of these methods will cause the commit object to be loaded +from the repository, if it hasn't been loaded already. + +=over + +=item $commit->tree + +Return an object that stringifies to the SHA1 of the tree that this +commit object refers to. (Currently this returns an actual string, +but don't rely on it.) + +=item $commit->parents + +Return an array of zero or more parent commit objects. Note that +commit objects stringify to their respective SHA1s, so you can +alternatively treat this as an array of SHA1 strings. + +=item $commit->author + +Return the author of this commit object as a Unicode string. + +=item $commit->committer + +Return the committer of this commit object as a Unicode string. + +=item $commit->message + +Return the commit message of this commit object as a Unicode string. + +=item $commit->encoding + +Return the encoding header of the commit object, or undef if no +encoding header is present; note that Git::Commit does the necessary +decoding for you, so you should not normally need this method. + +=back + +=cut + + +sub tree { + my $self = shift; + $self->_load; + return $self->{tree}; +} + +sub parents { + my $self = shift; + $self->_load; + return map { ref($self)->new($self->repo, $_) } @{$self->{parents}}; +} + +sub author { + my $self = shift; + $self->_load; + return $self->_decode($self->{author}); +} + +sub committer { + my $self = shift; + $self->_load; + return $self->_decode($self->{committer}); +} + +sub message { + my $self = shift; + $self->_load; + return $self->_decode($self->{message}); +} + +sub encoding { + my $self = shift; + $self->_load; + return $self->{encoding}; +} + +# Auxiliary method to load (and parse) the commit object from the +# repository if it hasn't already been loaded. Optional parameter: +# The raw contents of the commit object; the commit object will be +# retrieved from the repository if that parameter is not given. +sub _load { + my ($self, $raw_text) = shift; + return if exists $self->{message}; # already loaded + + my $sha1 = $self->sha1; + if (!defined $raw_text) { + # Retrieve from the repository. + (my $type, $raw_text) = $self->repo->get_object($sha1); + die "$sha1 is a $type object (expected a commit object)" + unless $type eq 'commit'; + } + + (my $header, $self->{message}) = split "\n\n", $raw_text, 2; + # Parse header. + for my $line (split "\n", $header) { + local $/ = "\n"; # for chomp + chomp($line); + my ($key, $value) = split ' ', $line, 2; + if ($key eq 'tree') { + $self->{tree} = $value; + } elsif ($key eq 'parent') { + push @{$self->{parents}}, $value; + } elsif ($key eq 'author') { + $self->{author} = $value; + } elsif ($key eq 'committer') { + $self->{committer} = $value; + } elsif ($key eq 'encoding') { + $self->{encoding} = $value; + } else { + # Ignore unrecognized header lines. + } + } + undef; +} + + +1; diff --git a/perl/Git/Object.pm b/perl/Git/Object.pm new file mode 100644 index 0000000000..8a158b2af0 --- /dev/null +++ b/perl/Git/Object.pm @@ -0,0 +1,94 @@ +=head1 NAME + +Git::Object - Object-oriented interface to Git objects (base class). + +=head1 DESCRIPTION + +Git::Object is a base class that provides access to commit, tag and +(unimplemented) tree objects. See L and L. + +Objects are loaded lazily, and hence instantiation is free. +Git::Object instances stringify to their SHA1s. + +=cut + + +use strict; +use warnings; + + +package Git::Object; + +use Encode qw(decode); + +use base qw(Exporter); + +our @EXPORT = qw(); +our @EXPORT_OK = qw(); + +use overload + '""' => \&sha1; + +=head1 METHODS + +=over + +=item Git::Object->new($repo, $sha1) + +Return a new Git::Object instance for the object with $sha1 in the +repository $repo (a Git::Repo instance). + +Note that this method does not check whether the object exists in the +repository. Trying to accessing its properties through a subclass +will fail if the object doesn't exist, however. + +=cut + +sub new { + my ($class, $repo, $sha1) = @_; + die "$repo is not a Git::Repo instance" unless $repo->isa('Git::Repo'); + my $self = {repo => $repo, sha1 => $sha1}; + return bless $self, $class; +} + +=item $obj->repo + +Return the Git::Repo instance this object was instantiated with. + +=cut + +sub repo { + shift->{repo} +} + +=item $obj->sha1 + +Return the SHA1 of this object. + +=cut + +sub sha1 { + shift->{sha1} +} + +# Helper method: Decode the given octets into a Unicode string, trying +# the $self->{encoding} encoding first, if defined, then trying UTF-8, +# then falling back to Latin 1. + +sub _decode { + my ($self, $octets) = @_; + my $string; + # Try $self->{encoding}: + eval { $string = decode($self->{encoding}, $octets, Encode::FB_CROAK) } + if $self->{encoding}; + # ... else try UTF-8: + eval { $string = decode('utf-8', $octets, Encode::FB_CROAK) } + unless defined $string; + # ... else fall back to Latin 1 (the first 256 Unicode code + # points coincide with Latin 1): + $string = $octets unless defined $string; + return $string; +} + + +1; diff --git a/perl/Git/Repo.pm b/perl/Git/Repo.pm new file mode 100644 index 0000000000..2224c882fe --- /dev/null +++ b/perl/Git/Repo.pm @@ -0,0 +1,274 @@ +=head1 NAME + +Git::Repo - Read-only access to the Git repositories. + +=head1 DESCRIPTION + +Git::Repo aims to provide low-level access to Git repositories. For +instance, you can resolve object names (like 'HEAD~2') to SHA1s, and +inspect objects. It does not attempt to be a wrapper around the git +plumbing or porcelain commands. + +Error handling is simple: On a consistent repository, the Perl +interface will never die. You can use the get_sha1 method to resolve +arbitrary object names or check the existence of SHA1 hashes; get_sha1 +will return undef if the object does not exist in the repository. Any +SHA1 that is returned by get_sha1 can be safely passed to the other +Git::Repo methods. + +=head1 SYNOPSIS + + use Git::Repo; + + my $repo = Git::Repo->new( + repo_dir => '/path/to/repository.git', + git_binary => '/usr/bin/git'); + my $sha1 = $repo->get_sha1('HEAD'); + print "Last log message:\n\n" . $repo->get_commit($sha1)->message; + +=cut + + +use strict; +use warnings; +# We could be compatible to Perl 5.6, but it doesn't provide sane pipe +# handling (sane meaning does not go through shell, and allows for +# accessing the exit code), so we require 5.8 until someone decides to +# implement fork/exec-based pipe handling, plus possibly workarounds +# for Windows brokenness. +use 5.008; + + +package Git::Repo; + +use Git::Tag; +use Git::Commit; + +use IPC::Open2 qw(open2); +use IO::Handle; + +use base qw(Exporter); + +our @EXPORT = qw(); +our @EXPORT_OK = qw(); + +# Auxiliary subroutines + +sub _assert_opts { + die "must have an even number of arguments for named options" + unless $#_ % 2; +} + +sub _assert_sha1 { + my $sha1 = shift; + die "'$sha1' is not a SHA1 (need to use get_sha1?)" + unless $sha1 && $sha1 =~ /^[a-f0-9]{40}$/; +} + + +=head1 METHODS + +=head2 General methods + +=over + +=item $repo = Git::Repo->new(%opts) + +Return a new Git::Repo object. The following options are supported: + +=over + +=item 'repo_dir' + +The directory of the repository (mandatory). + +Note that this option is working-copy agnostic; you need to +instantiate it with the working copy's .git directory as the +'repo_dir' option. + +=item 'git_binary' + +The name or full path of the git binary (default: 'git'). + +=back + +Calling this method is free, since it does not check whether the +repository exists. Trying to access the repository through one of the +instance methods will fail if it doesn't exist though. + +Examples: + + $repo = Git::Repo->new(repo_dir => '/path/to/repository.git'); + $repo = Git::Repo->new(repo_dir => '/path/to/working_copy/.git'); + +=cut + +sub new { + my $class = shift; + _assert_opts @_; + my $self = {@_}; + bless $self, $class; + die 'no repo_dir given' unless $self->{repo_dir}; + return $self; +} + +=item $repo->repo_dir + +Return the directory of the repository (.../.git in case of a working +copy). + +=cut + +sub repo_dir { + shift->{repo_dir} +} + +=item $repo->git_binary + +Return the name of or path to the git binary (used with exec). + +=cut + +sub git_binary { + shift->{git_binary} +} + +# Return the first items of the git command line, for instance +# qw(/usr/bin/git --git-dir=/path/to/repo.git). +sub _git_cmd { + my $self = shift; + return ($self->git_binary || 'git', '--git-dir=' . $self->repo_dir); +} + + +=back + +=head2 Inspecting the repository + +=over + +=item $repo->get_sha1($extended_object_identifier) + +Look up the object identified by $extended_object_identifier and +return its SHA1 hash in scalar context or its ($sha1, $type, $size) in +list context, or undef or () if the lookup failed, where $type is one +of 'tag', 'commit', 'tree', or 'blob'. + +See L, section "Specifying Revisions", for the +syntax of the $extended_object_identifier string. + +Note that even if you pass a SHA1 hash, its existence is still +checked, and this method returns undef or () if it doesn't exist in +the repository. + +=cut + +sub get_sha1 { + my ($self, $object_id) = @_; + die 'no object identifier given' unless $object_id; + die 'object identifier must not contain newlines' if $object_id =~ /\n/; + unless ($self->{sha1_stdout}) { + # Open bidi pipe the first time get_sha1 is called. + # open2 raises an exception on error, no need to 'or die'. + open2($self->{sha1_stdout}, $self->{sha1_stdin}, + $self->_git_cmd, 'cat-file', '--batch-check'); + } + $self->{sha1_stdin}->print("$object_id\n") + or die 'cannot write to pipe'; + my $output = $self->{sha1_stdout}->getline + or die 'cannot read from pipe'; + chomp $output; + return if $output =~ /missing$/; + my ($sha1, $type, $size) = + ($output =~ /^([0-9a-f]{40}) ([a-z]+) ([0-9]+)$/) + or die "invalid response: $output"; + return wantarray ? ($sha1, $type, $size) : $sha1; +} + +=item $repo->get_object($sha1) + +Return the content (as a string) of the object identified by $sha1, or +die if no such object exists in the repository. In list context, +return the ($type, $content) of the object. + +Note that you may want to use the higher-level methods get_commit and +get_tag instead. + +=cut + +# Possible to-do items: Add optional $file_handle parameter. Guard +# against getting huge blobs back when we don't expect it (for +# instance, we could limit the size and send SIGPIPE to git if we get +# a blob that is too large). + +sub get_object { + my ($self, $sha1) = @_; + _assert_sha1($sha1); + + unless ($self->{object_stdout}) { + # Open bidi pipe the first time get_object is called. + # open2 raises an exception on error, no need to 'or die'. + open2($self->{object_stdout}, $self->{object_stdin}, + $self->_git_cmd, 'cat-file', '--batch'); + } + $self->{object_stdin}->print("$sha1\n") or die 'cannot write to pipe'; + my ($ret_sha1, $type, $size) = + split ' ', $self->{object_stdout}->getline + or die 'cannot read from pipe'; + die "'$sha1' not found in repository" if $type eq 'missing'; + $self->{object_stdout}->read(my $content, $size); + $self->{object_stdout}->getline; # eat trailing newline + return wantarray ? ($type, $content) : $content; +} + +=item $repo->get_commit($commit_sha1) + +Return a new L instance referring to the commit object +with SHA1 $commit_sha1. + +=cut + +sub get_commit { + my ($self, $sha1) = @_; + _assert_sha1($sha1); + return Git::Commit->new($self, $sha1); +} + +=item $repo->get_tag($tag_sha1) + +Return a new L instance referring to the tag object with SHA1 +$tag_sha1. + +=cut + +sub get_tag { + my ($self, $sha1) = @_; + _assert_sha1($sha1); + return Git::Tag->new($self, $sha1); +} + +=item $repo->name_rev($committish_sha1, $tags_only = 0) + +Return a symbolic name for the commit identified by $committish_sha1, +or undef if no name can be found; see L for details. +If $tags_only is true, no branch names are used to name the commit. + +=cut + +sub name_rev { + my ($self, $sha1, $tags_only) = @_; + _assert_sha1($sha1); + + # Note that we cannot use a bidi pipe here since name git + # name-rev --stdin has an excessively high start-up time. + # http://thread.gmane.org/gmane.comp.version-control.git/85531 + open my $fh, '-|', $self->_git_cmd, 'name-rev', + $tags_only ? '--tags' : (), '--name-only', $sha1 + or die 'error calling git binary'; + chomp(my $name = <$fh>); + close $fh or die 'git name-rev returned an unexpected error'; + return $name eq 'undefined' ? undef : $name; +} + + +1; diff --git a/perl/Git/RepoRoot.pm b/perl/Git/RepoRoot.pm new file mode 100644 index 0000000000..6c8e7495f4 --- /dev/null +++ b/perl/Git/RepoRoot.pm @@ -0,0 +1,103 @@ +=head1 NAME + +Git::RepoRoot - A factory class representing a root directory +containing Git repositories. + +=head1 DESCRIPTION + +Git::RepoRoot is a factory class to create L instances that +are located under a common root directory. It also allows for +specifying options that all Git::Repo instances will be created with. + +Using Git::RepoRoot to create Git::Repo instances is entirely +optional, but can be more convenient than instantiating them directly. + +=cut + + +use strict; +use warnings; + + +package Git::RepoRoot; + +use File::Spec; + +use Git::Repo; + +use base qw(Exporter); + +our @EXPORT = qw(); +our @EXPORT_OK = qw(); + +=head1 METHODS + +=over + +=item $repo_root = Git::RepoRoot->new(%opts) + +Return a new Git::RepoRoot object. The following options are +supported: + +=over + +=item 'root_dir' + +The directory holding all repositories. + +=back + +All other options will be passed through to Git::Repo->new. + +Example: + + $repo_root = Git::RepoRoot->new(root_dir => '/pub/git', + git_binary => '/usr/bin/git'); + +=cut + +sub new { + my $class = shift; + Git::Repo::_assert_opts(@_); + my $self = {@_}; + bless $self, $class; + die 'no root_dir given' unless $self->{root_dir}; + return $self; +} + +=item $repo_root->repo(%opts) + +Return a new L object. The following options are +supported: + +=over + +=item 'root_dir' + +The path of the repository relative to the repository root. + +=item 'repo_class' + +The Repo class to instantiate (default: 'Git::Repo'). + +=back + +All other options are passed through to Git::Repo. + +=cut + +sub repo { + my $self = shift; + Git::Repo::_assert_opts(@_); + my %opts = (%$self, @_); + die 'no repo_dir given' unless $opts{repo_dir}; + # not technically necessary, but to guard against errors in the caller: + die "you passed an absolute path ($opts{repo_dir})" + if $opts{repo_dir} =~ m!^/!; + my $repo_class = delete $opts{repo_class} || 'Git::Repo'; + $opts{repo_dir} = File::Spec->catfile($self->{root_dir}, $opts{repo_dir}); + return $repo_class->new(%opts); +} + + +1; diff --git a/perl/Git/Tag.pm b/perl/Git/Tag.pm new file mode 100644 index 0000000000..56224319c8 --- /dev/null +++ b/perl/Git/Tag.pm @@ -0,0 +1,169 @@ +=head1 NAME + +Git::Tag - Object-oriented interface to Git tag objects. + +=head1 DESCRIPTION + +Git::Tag is a class representing a tag object in a Git repository. It +stringifies to the tag object's SHA1. + +=cut + +use strict; +use warnings; + + +package Git::Tag; + +use base qw(Git::Object); + + +# Keep documentation in one place to save space. + +=head1 METHODS + +=head2 General Methods + +=over + +=item $tag = Git::Tag->new($repo, $sha1) + +Return a new Git::Tag instance for a tag object with $sha1 in +repository $repo. + +The tag object is loaded lazily. Hence, calls to this method are +free, and it does not check whether $sha1 exists and has the right +type. However, accessing any of the tag object's properties will fail +if $sha1 is not a valid tag object. + +The tagger and message methods return Unicode strings, decoded +according to the "encoding" header, with UTF-8 and then Latin-1 as +fallbacks. (These Unicode strings can contain code points greater +than 256 and are *not* UTF-8 strings; see man perlunitut on how Perl +handles Unicode.) + +You will usually want to call $repo->get_tag($sha1) instead of +instantiating this class directly; see L. + +=item $obj->repo + +Return the Git::Repo instance this object was instantiated with. + +=item $obj->sha1 + +Return the SHA1 of this tag object, as provided at instantiation time. + +=back + +=head2 Property Methods + +Calling any of these methods will cause the commit object to be loaded +from the repository, if it hasn't been loaded already. + +=over + +=item $tag->object + +Return the SHA1 string of the object referenced by this tag. + +=item $tag->type + +Return the type of the referenced object, as claimed by the tag +object. This is usually 'commit', but can be any of 'tag', 'commit', +'tree', or 'blob'. + +=item $tag->tagger + +Return the tagger string of this tag object. + +=item $tag->message + +Return the undecoded tag message of this tag object. + +=item $tag->encoding + +Return the encoding header of the tag object, or undef if no encoding +header is present; note that Git::Tag does the necessary decoding for +you, so you should not normally need this method. + +=back + +=cut + + +sub object { + my $self = shift; + $self->_load; + return $self->{object}; +} + +sub type { + my $self = shift; + $self->_load; + return $self->{type}; +} + +sub tag { + my $self = shift; + $self->_load; + return $self->_decode($self->{tag}); +} + +sub tagger { + my $self = shift; + $self->_load; + return $self->_decode($self->{tagger}); +} + +sub message { + my $self = shift; + $self->_load; + return $self->_decode($self->{message}); +} + +sub encoding { + my $self = shift; + $self->_load; + return $self->{encoding}; +} + +# Auxiliary method to load (and parse) the tag object from the +# repository if it hasn't already been loaded. Optional parameter: +# The raw contents of the tag object; the tag object will be retrieved +# from the repository if that parameter is not given. +sub _load { + my ($self, $raw_text) = shift; + return if exists $self->{message}; # already loaded + + my $sha1 = $self->sha1; + if (!defined $raw_text) { + (my $type, $raw_text) = $self->repo->get_object($sha1); + die "$sha1 is a $type object (expected a tag object)" + unless $type eq 'tag'; + } + + (my $header, $self->{message}) = split "\n\n", $raw_text, 2; + # Parse header. + for my $line (split "\n", $header) { + local $/ = "\n"; # for chomp + chomp($line); + my ($key, $value) = split ' ', $line, 2; + if ($key eq 'object') { + $self->{object} = $value; + } elsif ($key eq 'type') { + $self->{type} = $value; + } elsif ($key eq 'tag') { + $self->{tag} = $value; + } elsif ($key eq 'tagger') { + $self->{tagger} = $value; + } elsif ($key eq 'encoding') { + $self->{encoding} = $value; + } else { + # Ignore unrecognized header lines. + } + } + undef; +} + + +1; diff --git a/perl/Makefile b/perl/Makefile index e3dd1a5547..4572dc50a4 100644 --- a/perl/Makefile +++ b/perl/Makefile @@ -31,6 +31,7 @@ $(makfile): ../GIT-CFLAGS Makefile echo install: >> $@ echo ' mkdir -p "$(instdir_SQ)"' >> $@ echo ' $(RM) "$(instdir_SQ)/Git.pm"; cp Git.pm "$(instdir_SQ)"' >> $@ + echo ' mkdir -p "$(instdir_SQ)/Git"; $(RM) "$(instdir_SQ)"/Git/*.pm; cp Git/*.pm "$(instdir_SQ)/Git"' >> $@ echo ' $(RM) "$(instdir_SQ)/Error.pm"' >> $@ '$(PERL_PATH_SQ)' -MError -e 'exit($$Error::VERSION < 0.15009)' || \ echo ' cp private-Error.pm "$(instdir_SQ)/Error.pm"' >> $@ diff --git a/perl/Makefile.PL b/perl/Makefile.PL index 320253eb8e..6c621605a4 100644 --- a/perl/Makefile.PL +++ b/perl/Makefile.PL @@ -8,7 +8,15 @@ instlibdir: MAKE_FRAG } -my %pm = ('Git.pm' => '$(INST_LIBDIR)/Git.pm'); +# Note that when changing %pm, you'll have to remove pm_to_blib rather +# than the blib directory to .force the .pm files to be re-installed +# to blib/lib. +my %pm = ('Git.pm' => '$(INST_LIBDIR)/Git.pm', + 'Git/Repo.pm' => '$(INST_LIBDIR)/Git/Repo.pm', + 'Git/RepoRoot.pm' => '$(INST_LIBDIR)/Git/RepoRoot.pm', + 'Git/Commit.pm' => '$(INST_LIBDIR)/Git/Commit.pm', + 'Git/Tag.pm' => '$(INST_LIBDIR)/Git/Tag.pm', + 'Git/Object.pm' => '$(INST_LIBDIR)/Git/Object.pm'); # We come with our own bundled Error.pm. It's not in the set of default # Perl modules so install it if it's not available on the system yet. diff --git a/t/t9710-perl-git-repo.sh b/t/t9710-perl-git-repo.sh new file mode 100755 index 0000000000..eca283d45f --- /dev/null +++ b/t/t9710-perl-git-repo.sh @@ -0,0 +1,49 @@ +#!/bin/sh +# +# Copyright (c) 2008 Lea Wiemann +# + +test_description='perl interface (Git/*.pm)' +. ./test-lib.sh + +"$PERL_PATH" -e 'use 5.008' 2>/dev/null || { + say_color skip "Perl version older than 5.8, skipping test" + test_done +} + +# Set up test repository. Tagging/branching is a little tricky +# because it needs to stay unambiguous for the name_rev tests. + +test_expect_success \ + 'set up test repository' \ + 'echo "test file 1" > file1 && + echo "test file 2" > file2 && + mkdir directory1 && + echo "in directory1" >> directory1/file && + mkdir directory2 && + echo "in directory2" >> directory2/file && + git add . && + git commit -m "first commit" && + + git tag -a -m "tag message 1" tag-object-1 && + + echo "changed file 1" > file1 && + git commit -a -m "second commit" && + + git branch branch-2 && + + echo "changed file 2" > file2 && + git commit -a -m "third commit" && + + git tag -a -m "tag message 3" tag-object-3 && + git tag -a -m "indirect tag message 3" indirect-tag-3 tag-object-3 && + + echo "changed file 1 again" > file1 && + git commit -a -m "fourth commit" + ' + +test_external_without_stderr \ + 'Git::Repo API' \ + "$PERL_PATH" ../t9710/test.pl + +test_done diff --git a/t/t9710/test.pl b/t/t9710/test.pl new file mode 100755 index 0000000000..8fca725412 --- /dev/null +++ b/t/t9710/test.pl @@ -0,0 +1,136 @@ +#!/usr/bin/perl +use lib (split(/:/, $ENV{GITPERLLIB})); + +use warnings; +use strict; + +use Test::More qw(no_plan); +use Cwd; +use File::Basename; +use File::Temp; + +BEGIN { use_ok('Git::Repo') } + +sub dies_ok (&;$) { + my ($coderef, $descr) = @_; + eval { $coderef->(); }; + ok($@, $descr); +} + +sub lives_ok (&;$) { + my ($coderef, $descr) = @_; + eval { $coderef->(); }; + ok(!$@, $descr); +} + +our $old_stderr; +sub discard_stderr { + open our $old_stderr, ">&", STDERR or die "cannot save STDERR"; + close STDERR; +} +sub restore_stderr { + open STDERR, ">&", $old_stderr or die "cannot restore STDERR"; +} + +# set up +our $abs_wc_dir = Cwd->cwd; +ok(our $r = Git::Repo->new(repo_dir => "./.git"), 'open repository'); +sub rev_parse { + my $name = shift; + chomp(my $sha1 = `git rev-parse $name 2> /dev/null`); + $sha1 or undef; +} + +my @revisions = split /\s/, `git-rev-list --first-parent HEAD`; +my $head = $revisions[0]; + +# get_sha1 +is($r->get_sha1('HEAD'), $head, 'get_sha1: scalar'); +is($r->get_sha1('HEAD'), $head, 'get_sha1: scalar, repeated'); +my($sha1, $type, $head_size) = $r->get_sha1('HEAD'); +is($sha1, $head, 'get_sha1: array (SHA1)'); +is($type, 'commit', 'get_sha1: array (commit)'); +ok($head_size > 0, 'get_sha1: array (size)'); + +# get_object +is_deeply([$r->get_object($r->get_sha1("$revisions[-1]:file1"))], ['blob', "test file 1\n"], 'get_object: blob'); +is_deeply([$r->get_object($r->get_sha1("$revisions[-1]:file1"))], ['blob', "test file 1\n"], 'get_object: blob, repeated'); +dies_ok { $r->get_object('0' x 40) } 'get_object: non-existent sha1'; + +# get_commit +isa_ok($r->get_commit($revisions[-1]), 'Git::Commit', + 'get_commit: returns Git::Commit object'); + +# get_tag +isa_ok($r->get_tag($r->get_sha1('tag-object-1')), 'Git::Tag', + 'get_tag: returns Git::Tag object'); + +# name_rev +is($r->name_rev($revisions[-2]), 'branch-2', 'name_rev: branch'); +is($r->name_rev($head, 1), undef, 'name_rev: branch, tags only'); +is($r->name_rev($revisions[-1]), 'tags/tag-object-1^0', 'name_rev: tag object'); +is($r->name_rev($revisions[-1], 1), 'tag-object-1^0', 'name_rev: tag object, tags only'); + + + +# Git::Commmit +print "# Git::Commit:\n"; + +BEGIN { use_ok('Git::Commit') } + +my $invalid_commit = Git::Commit->new($r, '0' x 40); +is($invalid_commit->sha1, '0' x 40, 'new, sha1: accept invalid SHA1'); +dies_ok { $invalid_commit->tree } 'die on accessing properties of invalid SHA1s'; + +$invalid_commit = Git::Commit->new($r, $r->get_sha1('HEAD:')); # tree, not commit +dies_ok { $invalid_commit->tree } 'die on accessing properties of non-commit objects'; + +my $c = Git::Commit->new($r, $revisions[-2]); +is($c->repo, $r, 'repo: basic'); +is($c->sha1, $revisions[-2], 'sha1: basic'); +is($c->{parents}, undef, 'lazy loading: not loaded after reading SHA1'); +is($c->tree, $r->get_sha1("$revisions[-2]:"), 'tree: basic'); +ok($c->{parents}, 'lazy loading: loaded after reading tree'); +is_deeply([$c->parents], [$revisions[-1]], 'parents: basic'); +like($c->author, qr/A U Thor [0-9]+ \+0000/, 'author: basic'); +like($c->committer, qr/C O Mitter [0-9]+ \+0000/, 'committer: basic'); +is($c->encoding, undef, 'encoding: undef'); +is($c->message, "second commit\n", 'message: basic'); +is($c, $c->sha1, 'stringify: basic'); + +# error handling +dies_ok { Git::Commit->new($r, $r->get_sha1('tag-object-3'))->_load } + 'new: pass tag SHA1 (dies)'; +dies_ok { Git::Commit->new($r, '0' x 40)->_load } + 'new: pass invalid SHA1 (dies)'; + + +# Git::Tag +print "# Git::Tag:\n"; + +BEGIN { use_ok('Git::Tag') } + +# We don't test functionality inherited from Git::Object that we +# already tested in the Git::Commit tests. + +my $t = Git::Tag->new($r, $r->get_sha1('tag-object-1')); +is($t->tag, 'tag-object-1', 'tag: basic'); +is($t->object, $revisions[-1], 'object: basic'); +is($t->type, 'commit', 'tag: type'); +like($t->tagger, qr/C O Mitter [0-9]+ \+0000/, 'tagger: basic'); +is($t->encoding, undef, 'encoding: undef'); +is($t->message, "tag message 1\n", 'message: basic'); + +# error handling +dies_ok { Git::Tag->new($r, $head)->_load } 'new: pass commit SHA1 (dies)'; +dies_ok { Git::Tag->new($r, '0' x 40)->_load } 'new: pass invalid SHA1 (dies)'; + + +# Git::RepoRoot +print "# Git::RepoRoot:\n"; + +BEGIN { use_ok('Git::RepoRoot'); } + +my $reporoot = Git::RepoRoot->new(root_dir => $abs_wc_dir); +is($reporoot->repo(repo_dir => '.git')->get_sha1('HEAD'), $head, + 'repo: basic'); -- 2.11.4.GIT