#!perl
use strict;
use warnings;
use Test::More;
use Git::PurePerl;
use Path::Class;
for my $directory (qw(test-init test-init-bare.git)) {
dir($directory)->rmtree;
my $git;
if ( $directory eq 'test-init-bare.git' ) {
$git = Git::PurePerl->init( gitdir => $directory );
} else {
$git = Git::PurePerl->init( directory => $directory );
}
isa_ok( $git, 'Git::PurePerl', 'can init' );
is( $git->description,
'Unnamed repository; edit this file to name it for gitweb.' );
is( $git->all_sha1s->all, 0, 'does not contain any sha1s' );
is( $git->all_objects->all, 0, 'does not contain any objects' );
my $hello = Git::PurePerl::NewObject::Blob->new( content => 'hello' );
$git->put_object($hello);
is( $hello->sha1, 'b6fc4c620b67d95f953a5c1c1230aaab5db5a1b0' );
is( $git->get_object('b6fc4c620b67d95f953a5c1c1230aaab5db5a1b0')->content,
'hello' );
my $there = Git::PurePerl::NewObject::Blob->new( content => 'there' );
$git->put_object($there);
is( $there->sha1, 'c78ee1a5bdf46d22da300b68d50bc45c587c3293' );
is( $git->get_object('c78ee1a5bdf46d22da300b68d50bc45c587c3293')->content,
'there' );
my $hello_de = Git::PurePerl::NewDirectoryEntry->new(
mode => '100644',
filename => 'hello.txt',
sha1 => $hello->sha1,
);
my $there_de = Git::PurePerl::NewDirectoryEntry->new(
mode => '100644',
filename => 'there.txt',
sha1 => $there->sha1,
);
my $tree = Git::PurePerl::NewObject::Tree->new(
directory_entries => [ $hello_de, $there_de ] );
is( $tree->sha1, '6d991aebc86bd09e86d74bb84bb9ebfb97e18026' );
$git->put_object($tree);
my $tree2 = $git->get_object('6d991aebc86bd09e86d74bb84bb9ebfb97e18026');
is( $tree2->kind, 'tree' );
is( $tree2->size, 74 );
my @directory_entries = $tree2->directory_entries;
is( @directory_entries, 2 );
my $directory_entry = $directory_entries[0];
is( $directory_entry->mode, '100644' );
is( $directory_entry->filename, 'hello.txt' );
is( $directory_entry->sha1, 'b6fc4c620b67d95f953a5c1c1230aaab5db5a1b0' );
my $directory_entry2 = $directory_entries[1];
is( $directory_entry2->mode, '100644' );
is( $directory_entry2->filename, 'there.txt' );
is( $directory_entry2->sha1, 'c78ee1a5bdf46d22da300b68d50bc45c587c3293' );
my $actor = Git::PurePerl::Actor->new(
name => 'Your Name Comes Here',
email => 'you@yourdomain.example.com'
);
my $commit = Git::PurePerl::NewObject::Commit->new(
tree => $tree->sha1,
author => $actor,
authored_time => DateTime->from_epoch( epoch => 1240341681 ),
committer => $actor,
committed_time => DateTime->from_epoch( epoch => 1240341682 ),
comment => 'Fix',
);
is( $commit->sha1, '860caea5ba298bb4f1df9a80fad84951fcc7db72' );
$git->put_object($commit);
my $commit2
= $git->get_object('860caea5ba298bb4f1df9a80fad84951fcc7db72');
is( $commit2->tree_sha1, $tree->sha1 );
isa_ok( $commit2->author, 'Git::PurePerl::Actor' );
is( $commit2->author->name, 'Your Name Comes Here' );
is( $commit2->author->email, 'you@yourdomain.example.com' );
isa_ok( $commit2->committer, 'Git::PurePerl::Actor' );
is( $commit2->committer->name, 'Your Name Comes Here' );
is( $commit2->committer->email, 'you@yourdomain.example.com' );
is( $commit2->authored_time->epoch, 1240341681 );
is( $commit2->committed_time->epoch, 1240341682 );
is( $commit2->comment, 'Fix' );
if ( $directory eq 'test-init-bare.git' ) {
$git = Git::PurePerl->new( gitdir => $directory );
} else {
$git = Git::PurePerl->new( directory => $directory );
}
isa_ok( $git, 'Git::PurePerl', 'can get object' );
is( $git->all_sha1s->all, 4, 'contains four sha1s' );
is( $git->all_objects->all, 4, 'contains four objects' );
my $checkout_directory = dir('t/checkout');
$checkout_directory->rmtree;
$checkout_directory->mkpath;
unless ( $directory eq 'test-init-bare.git' ) {
$git->checkout($checkout_directory);
is_deeply(
[ sort $checkout_directory->as_foreign('Unix')->children ],
[ 't/checkout/hello.txt', 't/checkout/there.txt' ],
'checkout has two files'
);
is( file('t/checkout/hello.txt')->slurp,
'hello', 'hello.txt has latest content' );
is( file('t/checkout/there.txt')->slurp,
'there', 'there.txt has latest content' );
}
is_deeply( [ $git->ref_names ], ['refs/heads/master'],
'have ref master' );
isa_ok(
$git->ref('refs/heads/master'),
'Git::PurePerl::Object::Commit',
'have master commit'
);
is( $git->ref('refs/heads/master')->sha1,
$commit->sha1, 'master points to our commit' );
my $here = Git::PurePerl::NewObject::Blob->new( content => 'here' );
$git->put_object($here);
my $here_de = Git::PurePerl::NewDirectoryEntry->new(
mode => '100644',
filename => 'there.txt',
sha1 => $here->sha1,
);
$tree = Git::PurePerl::NewObject::Tree->new(
directory_entries => [ $hello_de, $here_de ] );
$git->put_object($tree);
my $newcommit = Git::PurePerl::NewObject::Commit->new(
tree => $tree->sha1,
parent => $commit->sha1,
author => $actor,
authored_time => DateTime->from_epoch( epoch => 1240341683 ),
committer => $actor,
committed_time => DateTime->from_epoch( epoch => 1240341684 ),
comment => 'Fix again',
);
$git->put_object($newcommit);
my $newcommit2 = $git->get_object( $newcommit->sha1 );
isa_ok( $newcommit2->author, 'Git::PurePerl::Actor' );
is( $newcommit2->author->name, 'Your Name Comes Here' );
is( $newcommit2->author->email, 'you@yourdomain.example.com' );
isa_ok( $newcommit2->committer, 'Git::PurePerl::Actor' );
is( $newcommit2->committer->name, 'Your Name Comes Here' );
is( $newcommit2->committer->email, 'you@yourdomain.example.com' );
is( $newcommit2->authored_time->epoch, 1240341683 );
is( $newcommit2->committed_time->epoch, 1240341684 );
is( $newcommit2->comment, 'Fix again' );
is( $git->ref('refs/heads/master')->sha1,
$newcommit->sha1, 'master updated' );
is( $git->all_sha1s->all, 7, 'contains seven sha1s' );
is( $git->all_objects->all, 7, 'contains seven objects' );
}
done_testing;