r25590 - in /branches/upstream/libgit-fastexport-perl/current: Changes MANIFEST META.yml lib/Git/FastExport.pm script/git-stitch-repo t/10fast-export.t t/30stitch-repo.t t/Utils.pm t/git-fast-export.t
efaistos-guest at users.alioth.debian.org
efaistos-guest at users.alioth.debian.org
Wed Sep 24 17:19:46 UTC 2008
Author: efaistos-guest
Date: Wed Sep 24 17:19:43 2008
New Revision: 25590
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=25590
Log:
[svn-upgrade] Integrating new upstream version, libgit-fastexport-perl (0.04)
Added:
branches/upstream/libgit-fastexport-perl/current/t/10fast-export.t
branches/upstream/libgit-fastexport-perl/current/t/30stitch-repo.t
branches/upstream/libgit-fastexport-perl/current/t/Utils.pm
Removed:
branches/upstream/libgit-fastexport-perl/current/t/git-fast-export.t
Modified:
branches/upstream/libgit-fastexport-perl/current/Changes
branches/upstream/libgit-fastexport-perl/current/MANIFEST
branches/upstream/libgit-fastexport-perl/current/META.yml
branches/upstream/libgit-fastexport-perl/current/lib/Git/FastExport.pm
branches/upstream/libgit-fastexport-perl/current/script/git-stitch-repo
Modified: branches/upstream/libgit-fastexport-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgit-fastexport-perl/current/Changes?rev=25590&op=diff
==============================================================================
--- branches/upstream/libgit-fastexport-perl/current/Changes (original)
+++ branches/upstream/libgit-fastexport-perl/current/Changes Wed Sep 24 17:19:43 2008
@@ -1,4 +1,20 @@
Revision history for Perl extension Git::FastExport
+
+0.04 Wed Aug 20 22:04:30 CEST 2008
+ [ENHANCEMENTS]
+ - git-stitch-repo: fixed a bug that caused many commits/branches
+ to be lost because different branches were given the same name.
+ [DOCUMENTATION]
+ - improved documentation for git-stitch-repo
+ [TESTS]
+ - t/30stitch-repot.t actually tests the results of running
+ git-stitch-repo on several different configurations
+
+0.03 Mon Jul 7 19:29:23 CEST 2008
+ [ENHANCEMENTS]
+ - git-stitch-repo: fixed a segmentation fault that occured
+ at program destruction, because of a huge self-referential
+ hash of hashes
0.02 Fri Jul 4 11:03:54 CEST 2008
[DOCUMENTATION]
Modified: branches/upstream/libgit-fastexport-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgit-fastexport-perl/current/MANIFEST?rev=25590&op=diff
==============================================================================
--- branches/upstream/libgit-fastexport-perl/current/MANIFEST (original)
+++ branches/upstream/libgit-fastexport-perl/current/MANIFEST Wed Sep 24 17:19:43 2008
@@ -8,7 +8,9 @@
script/git-stitch-repo
t/00load.t
t/01new.t
+t/10fast-export.t
+t/30stitch-repo.t
t/fast-export
-t/git-fast-export.t
t/pod-coverage.t
t/pod.t
+t/Utils.pm
Modified: branches/upstream/libgit-fastexport-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgit-fastexport-perl/current/META.yml?rev=25590&op=diff
==============================================================================
--- branches/upstream/libgit-fastexport-perl/current/META.yml (original)
+++ branches/upstream/libgit-fastexport-perl/current/META.yml Wed Sep 24 17:19:43 2008
@@ -1,6 +1,6 @@
---
name: Git-FastExport
-version: 0.02
+version: 0.04
author: []
abstract: A module to parse the output of git-fast-export
license: perl
@@ -11,7 +11,7 @@
provides:
Git::FastExport:
file: lib/Git/FastExport.pm
- version: 0.02
+ version: 0.04
Git::FastExport::Block:
file: lib/Git/FastExport.pm
generated_by: Module::Build version 0.2808
Modified: branches/upstream/libgit-fastexport-perl/current/lib/Git/FastExport.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgit-fastexport-perl/current/lib/Git/FastExport.pm?rev=25590&op=diff
==============================================================================
--- branches/upstream/libgit-fastexport-perl/current/lib/Git/FastExport.pm (original)
+++ branches/upstream/libgit-fastexport-perl/current/lib/Git/FastExport.pm Wed Sep 24 17:19:43 2008
@@ -5,7 +5,7 @@
use Cwd;
use IPC::Open2;
-our $VERSION = '0.02';
+our $VERSION = '0.04';
sub new {
my ( $class, $repo ) = @_;
Modified: branches/upstream/libgit-fastexport-perl/current/script/git-stitch-repo
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgit-fastexport-perl/current/script/git-stitch-repo?rev=25590&op=diff
==============================================================================
--- branches/upstream/libgit-fastexport-perl/current/script/git-stitch-repo (original)
+++ branches/upstream/libgit-fastexport-perl/current/script/git-stitch-repo Wed Sep 24 17:19:43 2008
@@ -3,14 +3,17 @@
use warnings;
use Git;
use Git::FastExport;
-
-our $VERSION = 0.02;
+use File::Spec::Functions qw( rel2abs );
+
+our $VERSION = '0.04';
my %repo;
# process command-line parameters
+my $name = 'A';
while (@ARGV) {
my ( $repo, $dir ) = split /:/, shift @ARGV, 2;
+ $repo = rel2abs($repo);
$dir ||= '';
# create an export parser for each repo
@@ -24,19 +27,20 @@
$repo{$repo}{repo} = $repo;
$repo{$repo}{dir} = $dir;
$repo{$repo}{parser} = $parser;
+ $repo{$repo}{name} = $dir || $name;
+ $name++;
}
# repositories that we will process
my @repos = values %repo;
-my $mark = 1_000_000; # mark counter in the new rpo
+my $mark = 1_000_000; # mark counter in the new repo
my %mark_map; # map marks in source repos to marks in the new repo
# get the first commits
$_->{commit} = next_commit( $_->{parser} ) for @repos;
# main loop
-use Data::Dumper;
my $last;
my %commits;
while (@repos) {
@@ -81,6 +85,9 @@
merge => exists $commit->{merge},
};
+ # mark our original source
+ $commit->{header} =~ s/$/-$repo->{name}/;
+
# this commit's parents
my @parents = map {/:(\d+)/g} @{ $commit->{from} || [] },
@{ $commit->{merge} || [] };
@@ -99,7 +106,7 @@
# update the parents information
for my $parent ( map { $parent_map{$_} } @parents ) {
- push @{ $commits{$parent}{children} }, $node;
+ push @{ $commits{$parent}{children} }, $node->{name};
}
# dump the commit
@@ -149,21 +156,24 @@
return $node if ( !@{ $node->{children} } );
# some children nodes are local
- return $node if grep { $_->{repo} eq $repo } @{ $node->{children} };
+ return $node
+ if grep { $commits{$_}->{repo} eq $repo } @{ $node->{children} };
# there's a child in the same branch
if ( my ($peer)
- = grep { $_->{branch} eq $branch } @{ $node->{children} } )
+ = grep { $commits{$_}->{branch} eq $branch }
+ @{ $node->{children} } )
{
+
# but don't go past another repo's merges
- return $node if $peer->{merge};
- $node = $peer;
+ # FIXME - unless it only includes ancestors of ours
+ return $node if $commits{$peer}->{merge};
+ $node = $commits{$peer};
}
# or pick the first child (as good as any)
else {
-
- $node = $node->{children}[0];
+ $node = $commits{ $node->{children}[0] };
}
}
}
@@ -186,46 +196,81 @@
a new repository containing all the commits in a new commit tree
that respects the history of all the source repositories.
+Typical usage is like this:
+
+ $ ls
+ A B
+ $ mkdir RESULT
+ $ cd RESULT
+ $ git-init
+ $ git-stitch-repo ../A:A ../B:B | git-fast-import
+
+The C<RESULT> repository will contain all commits from repositories A
+and B, with the files from A in subdirectory F<A/> and the files from
+B in subdirectory F<B/>.
+
+B<git-stich-repo> works perfectly with repositories that have a B<linear>
+history (no merges). It has successfully been tested with 16 linear
+repositories, and produced the expected result.
+
=head2 Example
Imagine we have two repositories A and B that we want to stitch into
a repository C so that all the files from A are in subdirectory F<A>
and all the files from B are in subdirectory F<B>.
+Note: in the following ASCII art graphs, horizontal order is chronological.
+
Repository A:
- topic
- ' ,master
- A3---A5
- / /
- A1---A2---A4
+ topic
+ ' ,master
+ ,----A3---A5
+ / /
+ A1--A2---A4---'
Branch I<master> points to A5 and branch I<topic> points to A3.
Repository B:
- ,topic ,master
- B3---B5---B7---B8
- / /
- B1---B2---B4---B6
+
+ ,topic ,master
+ ,---------B3---B5---B7---B8
+ / /
+ B1---B2---B4---B6--------'
Branch I<master> points to B8 and branch I<topic> points to B5.
-The C repository should preserve chronology, commit relationships and
+The RESULT repository should preserve chronology, commit relationships and
branches as much as possible, while giving the impression that the
-directories F<A> & F<B> did live side-by-side all the time.
+directories F<A/> & F<B/> did live side-by-side all the time.
Assuming additional timestamps not shown on the above graphs,
B<git-stitch-repo> will produce a B<git-fast-import> stream that will
create the following history:
- ,topic ,master
- A3---B3---A5---B5---B7---B8
- / / /
- A1---B1---A2---B2---A4---B4--------B6
-
-
-Note that the current result is slightly buggy, since A5 wasn't on the
-I<topic> branch in the original graph for A.
+ ,topic-A
+ ,---------------A3---B3 master-A
+ / \ ' ,topic-B
+ / ,--------------A5---B5
+ / / \ ,master-B
+ A1---B1---A2---B2---A4---B4---B6-----------------B7---B8
+
+
+=head1 BUGS & IMPROVEMENTS
+
+Any mathematician will tell you there are many many ways to stitch two
+trees together. This programs tries very hard not to create inconsistent
+history with regard to each input repository.
+
+The current implementation can (and will be) improved. I'm very interested
+in test repositories that do not give the expected results.
+
+One of the issues is that we currently refuse to stitch a node after
+a merge from another repository. For the current example, that would
+mean that any commit having A5 as a parent would be attached to B5,
+and not to B8.
+
+Fixing this is in the TODO list.
=head1 AUTHOR
Added: branches/upstream/libgit-fastexport-perl/current/t/10fast-export.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgit-fastexport-perl/current/t/10fast-export.t?rev=25590&op=file
==============================================================================
--- branches/upstream/libgit-fastexport-perl/current/t/10fast-export.t (added)
+++ branches/upstream/libgit-fastexport-perl/current/t/10fast-export.t Wed Sep 24 17:19:43 2008
@@ -1,0 +1,269 @@
+use strict;
+use warnings;
+use Test::More;
+use File::Slurp;
+
+my @latin = split m!^----\n!m, << 'EOT';
+perferendis
+sit
+praesentium
+doloribus
+itaque
+illum
+facere
+aliquip
+----
+harum
+rerum
+magnam
+----
+nam
+laboriosam
+tempora
+ullam
+odit
+quidem
+----
+blanditiis
+nulla
+laboriosam
+----
+vitae
+proident
+sit
+----
+officiis
+fuga
+ipsum
+----
+beatae
+dicta
+debitis
+----
+vitae
+repudiandae
+laboriosam
+EOT
+
+my @blocks = (
+ { type => 'blob',
+ header => 'blob',
+ data => join( '', @latin[ 0, 1, 2 ] ),
+ mark => ['mark :1'],
+ footer => "\012",
+ },
+ { type => 'commit',
+ header => 'commit refs/heads/before',
+ data => "first commit\n",
+ mark => ['mark :2'],
+ author => [
+ 'author Philippe Bruhat (BooK) <book at cpan.org> 1213115458 +0200'
+ ],
+ committer => [
+ 'committer Philippe Bruhat (BooK) <book at cpan.org> 1213115458 +0200'
+ ],
+ files => ['M 0100644 :1 loremipsum.txt'],
+ date => 1213115458,
+ footer => "\012",
+ },
+ { type => 'blob',
+ header => 'blob',
+ data => join( '', @latin[ 0, 1, 2, 3 ] ),
+ mark => ['mark :3'],
+ footer => "\012",
+ },
+ { type => 'commit',
+ header => 'commit refs/heads/before',
+ mark => ['mark :4'],
+ author => [
+ 'author Philippe Bruhat (BooK) <book at cpan.org> 1213115469 +0200'
+ ],
+ committer => [
+ 'committer Philippe Bruhat (BooK) <book at cpan.org> 1213115469 +0200'
+ ],
+ data => "second commit\n",
+ from => ['from :2'],
+ files => ['M 0100644 :3 loremipsum.txt'],
+ date => 1213115469,
+ footer => "\012",
+ },
+ { type => 'blob',
+ header => 'blob',
+ data => join( '', @latin[ 0, 1, 2, 3, 4 ] ),
+ mark => ['mark :5'],
+ footer => "\012",
+ },
+ { type => 'progress',
+ header => 'progress [] 5 objects',
+ },
+ { type => 'commit',
+ header => 'commit refs/heads/master',
+ mark => ['mark :6'],
+ author => [
+ 'author Philippe Bruhat (BooK) <book at cpan.org> 1213115504 +0200'
+ ],
+ committer => [
+ 'committer Philippe Bruhat (BooK) <book at cpan.org> 1213115504 +0200'
+ ],
+ data => "another commit on master\n",
+ from => ['from :4'],
+ files => ['M 0100644 :5 loremipsum.txt'],
+ date => 1213115504,
+ footer => "\012",
+ },
+ { type => 'blob',
+ header => 'blob',
+ data => join( '', @latin[ 0, 2, 3 ] ),
+ mark => ['mark :7'],
+ footer => "\012",
+ },
+ { type => 'commit',
+ header => 'commit refs/tags/deletion',
+ mark => ['mark :8'],
+ author => [
+ 'author Philippe Bruhat (BooK) <book at cpan.org> 1213115522 +0200'
+ ],
+ committer => [
+ 'committer Philippe Bruhat (BooK) <book at cpan.org> 1213115522 +0200'
+ ],
+ data => "removed some lines\n",
+ from => ['from :4'],
+ files => ['M 0100644 :7 loremipsum.txt'],
+ date => 1213115522,
+ footer => "\012",
+ },
+ { type => 'blob',
+ header => 'blob',
+ data => join( '', @latin[ 0, 2, 3, 5 ] ),
+ mark => ['mark :9'],
+ footer => "\012",
+ },
+ { type => 'commit',
+ header => 'commit refs/heads/master',
+ mark => ['mark :10'],
+ author => [
+ 'author Philippe Bruhat (BooK) <book at cpan.org> 1213115555 +0200'
+ ],
+ committer => [
+ 'committer Philippe Bruhat (BooK) <book at cpan.org> 1213115555 +0200'
+ ],
+ data => "added some lines too\n",
+ from => ['from :8'],
+ files => ['M 0100644 :9 loremipsum.txt'],
+ date => 1213115555,
+ footer => "\012",
+ },
+ { type => 'progress',
+ header => 'progress [] 10 objects',
+ },
+ { type => 'blob',
+ header => 'blob',
+ data => join( '', @latin[ 0, 1, 2, 3, 4, 6 ] ),
+ mark => ['mark :11'],
+ footer => "\012",
+ },
+ { type => 'commit',
+ header => 'commit refs/heads/master',
+ mark => ['mark :12'],
+ author => [
+ 'author Philippe Bruhat (BooK) <book at cpan.org> 1213115577 +0200'
+ ],
+ committer => [
+ 'committer Philippe Bruhat (BooK) <book at cpan.org> 1213115577 +0200'
+ ],
+ data => "added some lines on the master\n",
+ from => ['from :6'],
+ files => ['M 0100644 :11 loremipsum.txt'],
+ date => 1213115577,
+ footer => "\012",
+ },
+ { type => 'blob',
+ header => 'blob',
+ data => join( '', @latin[ 0, 2, 3, 4, 6, 5 ] ),
+ mark => ['mark :13'],
+ footer => "\012",
+ },
+ { type => 'commit',
+ header => 'commit refs/heads/master',
+ mark => ['mark :14'],
+ author => [
+ 'author Philippe Bruhat (BooK) <book at cpan.org> 1213115620 +0200'
+ ],
+ committer => [
+ 'committer Philippe Bruhat (BooK) <book at cpan.org> 1213115620 +0200'
+ ],
+ data => "merged branch into master\n",
+ from => ['from :12'],
+ merge => ['merge :10'],
+ files => ['M 0100644 :13 loremipsum.txt'],
+ date => 1213115620,
+ footer => "\012",
+ },
+ { type => 'blob',
+ header => 'blob',
+ data => join( '', @latin[ 0, 2, 3, 4, 6, 5, 7 ] ),
+ mark => ['mark :15'],
+ footer => "\012",
+ },
+ { type => 'progress',
+ header => 'progress [] 15 objects',
+ },
+ { type => 'commit',
+ header => 'commit refs/heads/master',
+ mark => ['mark :16'],
+ author => [
+ 'author Philippe Bruhat (BooK) <book at cpan.org> 1213115889 +0200'
+ ],
+ committer => [
+ 'committer Philippe Bruhat (BooK) <book at cpan.org> 1213115889 +0200'
+ ],
+ data => "more latin words\n",
+ from => ['from :14'],
+ files => ['M 0100644 :15 loremipsum.txt'],
+ date => 1213115889,
+ footer => "\012",
+ },
+ { type => 'reset',
+ header => 'reset refs/tags/removal',
+ from => ['from :8'],
+ footer => "\012",
+ },
+);
+
+plan tests => 1 + 3 * @blocks + 2;
+
+use_ok('Git::FastExport');
+
+my $export = Git::FastExport->new();
+open my $fh, 't/fast-export' or die "Can't open t/fast-export: $!";
+my @strings;
+{
+ open my $gh, 't/fast-export' or die "Can't open t/fast-export: $!";
+ my $string = join '', <$gh>;
+ close $gh;
+ @strings
+ = split
+ /(?<=\012\012)|(?<=progress . objects\012)|(?<=progress .. objects\012)/m,
+ $string;
+
+ # we actually change the progress markers
+ s/progress/progress []/g for @strings;
+}
+
+$export->{export_fh} = $fh;
+
+$_ = 'canari';
+
+for my $block (@blocks) {
+ my $b = $export->next_block();
+ isa_ok( $b, 'Git::FastExport::Block' );
+ my $mesg = $block->{mark} ? $block->{mark}[0] : $block->{header};
+ chomp $mesg;
+ is_deeply( $b, $block, "$mesg object" );
+ is( $b->as_string, shift @strings, "$mesg string dump" );
+}
+
+is( $export->next_block(), undef, 'no more blocks' );
+
+is( $_, 'canari', 'the canari survived' );
+
Added: branches/upstream/libgit-fastexport-perl/current/t/30stitch-repo.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgit-fastexport-perl/current/t/30stitch-repo.t?rev=25590&op=file
==============================================================================
--- branches/upstream/libgit-fastexport-perl/current/t/30stitch-repo.t (added)
+++ branches/upstream/libgit-fastexport-perl/current/t/30stitch-repo.t Wed Sep 24 17:19:43 2008
@@ -1,0 +1,111 @@
+use strict;
+use warnings;
+use Test::More;
+use File::Temp qw( tempdir );
+use IPC::Open2;
+use t::Utils;
+
+my @tests = (
+
+ # source repositories, refs, expected repository
+ # linear trees
+ [ 'A1 A2-A1 A3-A2', 'master=A3', 'A1 A2-A1 A3-A2' ],
+ [ 'A1 A2-A1 A3-A2 B1 B2-B1 B3-B2',
+ 'master=A3 master=B3',
+ 'A1 A2-A1 A3-A2 B1-A3 B2-B1 B3-B2'
+ ],
+ [ 'A1 B1 A2-A1 B2-B1 A3-A2 B3-B2',
+ 'master=A3 master=B3',
+ 'A1 B1-A1 A2-B1 B2-A2 A3-B2 B3-A3'
+ ],
+ [ 'A1 B1 C1 A2-A1 B2-B1 C2-C1 A3-A2 B3-B2 C3-C2',
+ 'master=A3 master=B3 master=C3',
+ 'A1 B1-A1 C1-B1 A2-C1 B2-A2 C2-B2 A3-C2 B3-A3 C3-B3'
+ ],
+
+ # simple diamonds
+ [ 'A1 A2-A1 A3-A1 A4-A2A3', 'master=A4', 'A1 A2-A1 A3-A1 A4-A2A3' ],
+ [ 'A1 A2-A1 A3-A1 A4-A2A3 B1 B2-B1 B3-B1 B4-B2B3',
+ 'master=A4 master=B4',
+ 'A1 A2-A1 A3-A1 A4-A2A3 B1-A4 B2-B1 B3-B1 B4-B2B3'
+ ],
+ [ 'A1 B1 A2-A1 A3-A1 B2-B1 B3-B1 A4-A2A3 B4-B2B3',
+ 'master=A4 master=B4',
+ 'A1 B1-A1 A2-B1 B2-B1 A3-B2 B3-A2 A4-B3A3 B3-A4',
+ 'The two master branches should be the same'
+ ],
+ [ 'A1 B1 A2-A1 B2-B1 A3-A1 B3-B1 A4-A2A3 B4-B2B3',
+ 'master=A4 master=B4',
+ 'A1 B1-A1 A2-B1 B2-B1 A3-B2 B3-A2 A4-B3A3 B3-A4',
+ 'The two master branches should be the same'
+ ],
+ [ 'A1 B1 A2-A1 A3-A1 B2-B1 B3-B1 B4-B2B3 A4-A2A3 B5-B4 A5-A4',
+ 'master=A5 master=B5',
+ 'A1 B1-A1 A2-B1 B2-B1 A3-B2 B3-A2 B4-B3B2 B3-A4',
+ 'The two master branches should be the same'
+ ],
+
+ # other trees
+ [ 'A1 B1 A2-A1 B2-B1 A3-A2 A4-A2 B3-B2 B4-B2 A5-A4A3 B5-B3 B6-B4 B7-B6B5 B8-B7 A6-A5',
+ 'master=A6 master=B8 topic=A3 topic=B5',
+ 'A1 B1-A1 A2-B1 B2-A2 A3-B2 A4-B2 B3-A3 B4-A4 A5-B4B3 B5-A5 B6-B4 B7-B6B5 B8-B7 A6-B8',
+ 'A6 should be attached to B8'
+ ],
+ [ 'A1 B1 A2-A1 B2-B1 A3-A2 A4-A2 B3-B2 B4-B2 A5-A4A3 B5-B3 B6-B4 B7-B6B5 B8-B7 A6-A5 A7-A3 A8-A6',
+ 'master=A8 master=B8 topic=A7 topic=B5',
+ 'A1 B1-A1 A2-B1 B2-A2 A4-B2 B4-A4 B6-B4 A3-B2 B3-A3 A5-B4B3 B5-A5 B7-B5 B8-B7 A7-A5 A6-B8 A8-A6',
+ 'The two master branches should be the same'
+ ],
+);
+
+# useful hack for quick testing
+ at tests = grep {$_} @tests[@ARGV] if @ARGV;
+
+plan skip_all => 'No test selected' if !@tests;
+plan tests => scalar @tests;
+
+# the program we want to test
+my $gsr = File::Spec->rel2abs('script/git-stitch-repo');
+my $lib = File::Spec->rel2abs('lib');
+
+for my $t (@tests) {
+ my ( $src, $refs, $dst, $todo ) = @$t;
+
+ # a temporary directory for our tests
+ my $dir
+ = File::Spec->rel2abs( tempdir( 'git-XXXXX', CLEANUP => !@ARGV ) );
+
+ # create the source repositories
+ my @src = create_repos( $dir => $src, $refs );
+
+ # create the destination repository
+ my $repo = new_repo( $dir => 'RESULT' );
+
+ # run git-stitch-repo on the source repositories
+ my ( $in, $out );
+ my $pid
+ = open2( $out, $in, $^X, "-I$lib", $gsr, map { $_->wc_path } @src );
+
+ # run git-fast-import on the destination repository
+ my ( $fh, $c ) = $repo->command_input_pipe( 'fast-import', '--quiet' );
+
+ # pipe the output of git-stitch-repo into git-fast-import
+ while (<$out>) {
+ next if /^progress /; # ignore progress info
+ print {$fh} $_;
+ }
+ $repo->command_close_pipe( $fh, $c );
+
+ # get the description of the resulting repository
+ my $result = repo_description($repo);
+ if ($todo) {
+ TODO: {
+ local $TODO = $todo;
+ is( $result, $dst, "$src => $dst" );
+ }
+ }
+ else {
+ is( $result, $dst, "$src => $dst" );
+ }
+}
+
Added: branches/upstream/libgit-fastexport-perl/current/t/Utils.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libgit-fastexport-perl/current/t/Utils.pm?rev=25590&op=file
==============================================================================
--- branches/upstream/libgit-fastexport-perl/current/t/Utils.pm (added)
+++ branches/upstream/libgit-fastexport-perl/current/t/Utils.pm Wed Sep 24 17:19:43 2008
@@ -1,0 +1,231 @@
+use strict;
+use warnings;
+use File::Path;
+use File::Spec;
+use Cwd;
+use Git;
+
+# some data for the file content
+my @data = <DATA>;
+my $idx = 0;
+
+1;
+
+# create a new, empty repository
+sub new_repo {
+ my ( $dir, $name ) = @_;
+ my $cwd = getcwd;
+
+ # alas, this can't be done with Git.pm
+ my $wc = File::Spec->rel2abs( File::Spec->catfile( $dir, $name ) );
+ mkpath $wc;
+ chdir $wc;
+ `git-init`;
+ chdir $cwd;
+ return Git->repository( Directory => $wc );
+}
+
+# produce a text description of a given repository
+sub repo_description {
+ my ($repo) = @_;
+ my %log; # map sha1 to log message
+ my @commits;
+
+ # process the whole tree
+ my ( $fh, $c )
+ = $repo->command_output_pipe( 'log', '--pretty=format:%H-%P-%s',
+ '--date-order', '--all' );
+ while (<$fh>) {
+ chomp;
+ my ( $h, $p, $log ) = split /-/, $_, 3;
+ $log{$h} = $log;
+ $p =~ y/ //d;
+ push @commits, $p ? "$log-$p" : $log;
+ }
+ $repo->command_close_pipe( $fh, $c );
+
+ # replace SHA-1 by log name
+ my $desc = join ' ', reverse @commits;
+ $desc =~ s/(\w{40})/$log{$1}/g;
+
+ return $desc;
+}
+
+# create a set of repositories from a given description
+sub create_repos {
+ my ( $dir, $desc, $refs ) = @_;
+ my $info = { dir => $dir, repo => {}, sha1 => {} };
+
+ for my $commit ( split / /, $desc ) {
+ my ( $child, $parent ) = split /-/, $commit;
+ my @child = $child =~ /([A-Z]\d+)/g;
+ my @parent = $parent =~ /([A-Z]\d+)/g if $parent;
+
+ die "bad node description" if @child > 1 && @parent > 1;
+
+ if ( @child > 1 ) { # branch point
+ create_linear_commit( $info, $_, $parent[0] ) for @child;
+ }
+ elsif ( @parent > 1 ) { # merge point
+ create_merge_commit( $info, $child[0], @parent );
+ }
+ else { # simple, linear commit
+ create_linear_commit( $info, $child[0], $parent[0] );
+ }
+ sleep 1;
+ }
+
+ # setup the refs (branches & tags)
+ for my $ref ( split / /, $refs ) {
+ my ( $name, $type, $commit ) = split /([>=])/, $ref;
+ my $repo = $info->{repo}{ substr( $commit, 0, 1 ) };
+ if ( $type eq '=' ) { # branch
+ $repo->command( 'branch', '-D', $name )
+ if grep {/^..$name$/} $repo->command('branch');
+ $repo->command( 'branch', $name, $info->{sha1}{$commit} );
+ }
+ else { # tag
+ $repo->command( 'tag', $name, $info->{sha1}{$commit} );
+ }
+ }
+
+ # return the repository objects
+ return map { $info->{repo}{$_} } sort keys %{ $info->{repo} };
+}
+
+sub create_linear_commit {
+ my ( $info, $child, $parent ) = @_;
+ my $name = substr( $child, 0, 1 );
+
+ # create the repo if needed
+ my $repo = $info->{repo}{$name};
+ if ( !$repo ) {
+ $repo = $info->{repo}{$name} = new_repo( $info->{dir} => $name );
+ }
+
+ # checkout the parent commit
+ $repo->command( 'checkout', '-q', $info->{sha1}{$parent} ) if $parent;
+ my $base = File::Spec->catfile( $info->{dir}, $name );
+ update_file( $base, $name );
+ $repo->command( 'add', $name );
+ $repo->command( 'commit', '-m', $child );
+ $info->{sha1}{$child}
+ = $repo->command_oneline(qw( log -n 1 --pretty=format:%H HEAD ));
+}
+
+sub create_merge_commit {
+ my ( $info, $child, @parents ) = @_;
+ my $name = substr( $child, 0, 1 );
+ my $repo = $info->{repo}{$name};
+
+ # checkout the first parent
+ my $parent = shift @parents;
+ $repo->command( 'checkout', '-q', $info->{sha1}{$parent} );
+
+ # merge the other parents
+ eval {
+ $repo->command_noisy( 'merge', '-n',
+ map { $info->{sha1}{$_} } @parents,
+ );
+ 1;
+ }
+ or do {
+ my $base = File::Spec->catfile( $info->{dir}, $name );
+ update_file( $base, $name );
+ $repo->command( 'add', $name );
+ $repo->command( 'commit', '-m', $child );
+ };
+ $info->{sha1}{$child}
+ = $repo->command_oneline(qw( log -n 1 --pretty=format:%H HEAD ));
+}
+
+sub update_file {
+ my ($file) = File::Spec->catfile(@_);
+ open my $fh, '>', $file or die "Can't open $file: $!";
+ print $fh $data[ $idx++ % @data ];
+ close $fh;
+}
+
+__DATA__
+aieee
+aiieee
+awk
+awkkkkkk
+bam
+bang
+bang_eth
+bap
+biff
+bloop
+blurp
+boff
+bonk
+clange
+clank
+clank_est
+clash
+clunk
+clunk_eth
+crash
+crr_aaack
+crraack
+cr_r_a_a_ck
+crunch
+crunch_eth
+eee_yow
+flrbbbbb
+glipp
+glurpp
+kapow
+kayo
+ker_plop
+ker_sploosh
+klonk
+krunch
+ooooff
+ouch
+ouch_eth
+owww
+pam
+plop
+pow
+powie
+qunckkk
+rakkk
+rip
+slosh
+sock
+spla_a_t
+splatt
+sploosh
+swa_a_p
+swish
+swoosh
+thunk
+thwack
+thwacke
+thwape
+thwapp
+touche
+uggh
+urkk
+urkkk
+vronk
+whack
+whack_eth
+wham_eth
+whamm
+whap
+zam
+zamm
+zap
+zapeth
+zgruppp
+zlonk
+zlopp
+zlott
+zok
+zowie
+zwapp
+z_zwap
+zzzzzwap
More information about the Pkg-perl-cvs-commits
mailing list