get_path("path/to/file") convenience method

.gitignore

@@ -9,6 +9,7 @@ blib*
 pm_to_blib
 test-init-bare.git
 t/checkout/*
+test-project-nontrivial/*
 test-project-packs/*
 test-project-packs2/*
 test-project/*

lib/Git/PurePerl/Object/Commit.pm

@@ -91,5 +91,83 @@ sub parents {
     return map { $self->git->get_object( $_ ) } @{$self->parent_sha1s};
 }
 
+sub get_path {
+    my $self = shift;
+    my @path = split /\//, shift;
+    my $tree = $self->tree;
+
+  PATH_COMPONENT:
+    while (@path) {
+        return unless 'tree' eq $tree->kind;
+        my $component = shift @path;
+        next unless length($component);
+        my $entries = $tree->directory_entries;
+        for (@$entries) {
+            next unless $_->filename eq $component;
+            $tree = $_->object;
+            next PATH_COMPONENT;
+        }
+        return;
+    }
+
+    return $tree;
+}
+
+
 __PACKAGE__->meta->make_immutable;
 
+__END__
+
+=head1 NAME
+
+Git::PurePerl::Object::Commit - Git Commit Object
+
+=head1 SYNOPSIS
+
+    my $git = Git::PurePerl->new(
+        directory => '/path/to/git/'
+    );
+    my $commit = $git->master;
+
+    for my $entry ($commit->tree->directory_entries) {
+        # ...
+    }
+
+    my $blob = $commit->get_path( "foo/bar/baz.txt" );
+
+=head1 METHODS
+
+=over 4
+
+=item kind
+
+=item tree_sha1
+
+=item parent_sha1s
+
+=item parent_sha1
+
+=item parent
+
+=item parents
+
+=item author
+
+=item authored_time
+
+=item committer
+
+=item committed_time
+
+=item comment
+
+=item encoding
+
+=item tree
+
+=item get_path
+
+ my $tree = $commit->get_path( "foo/bar" );
+ my $blob = $commit->get_path( "foo/bar/baz.txt" );
+
+=cut

t/00_setup.t

@@ -4,7 +4,7 @@ use warnings;
 use Test::More;
 use Archive::Extract;
 
-foreach my $name qw(test-project test-project-packs test-project-packs2 test-encoding) {
+foreach my $name qw(test-project test-project-packs test-project-packs2 test-project-nontrivial test-encoding) {
     next if -d $name;
     my $ae = Archive::Extract->new( archive => "$name.tgz" );
     $ae->extract;

t/commit_get_path.t

@@ -0,0 +1,63 @@
+#!perl
+use strict;
+use warnings;
+use Test::More;
+use Git::PurePerl;
+
+my $git = Git::PurePerl->new( directory => 'test-project-nontrivial' );
+
+my $commit = $git->master;
+is( $commit->kind, 'commit' );
+
+my $tree  = $commit->tree;
+my $tree2 = $commit->get_path("/");
+is( $tree->sha1, $tree2->sha1, "getting root path" );
+
+$tree2 = $commit->get_path("");
+is( $tree->sha1, $tree2->sha1, "getting root path another way" );
+
+
+my $blob  = $commit->get_path("file.txt");
+my $blob2 = $commit->get_path("/file.txt");
+
+is( $blob->sha1, $blob2->sha1, "getting a file in different ways" );
+is( $blob->content, 'hello world!
+hello world, again
+',
+    "got correct file"
+  );
+
+
+$tree = $commit->get_path("foo");
+my @directory_entries = sort map $_->filename, $tree->directory_entries;
+is( @directory_entries, 2 );
+is( "@directory_entries", "another_file.txt bar" );
+
+
+$blob = $commit->get_path("foo/bar/yet_another_file.txt");
+
+is( $blob->content, 'OH HAI!
+', "got a deep file"
+  );
+
+
+$commit = $commit->parent;
+
+$blob = $commit->get_path("foo/bar/yet_another_file.txt");
+
+is( $blob, undef, "'yet_another_file.txt' is gone" );
+
+
+$blob = $commit->get_path("foo/another_file.txt");
+
+is( $blob->content, 'Hola
+', "'another_file.txt' is still here" );
+
+
+$tree = $commit->get_path("foo");
+@directory_entries = sort map $_->filename, $tree->directory_entries;
+is( @directory_entries, 1 );
+is( "@directory_entries", "another_file.txt" );
+
+
+done_testing;