From: Vincent Pit Date: Sun, 5 Oct 2008 15:45:08 +0000 (+0200) Subject: Import rgit-0.01 X-Git-Tag: v0.01^0 X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Frgit.git;a=commitdiff_plain;h=19bee8f647bfe6c94c5cb3cf6a60d7a43cbca222 Import rgit-0.01 --- 19bee8f647bfe6c94c5cb3cf6a60d7a43cbca222 diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..01ebb91 --- /dev/null +++ b/.gitignore @@ -0,0 +1,23 @@ +blib* +pm_to_blib* + +Makefile +Makefile.old +Build +_build* + +*.tar.gz +rgit-* + +core.* +*.[co] +*.so +*.bs +*.out +*.def +*.exp + +cover_db +*.gcda +*.gcov +*.gcno diff --git a/Changes b/Changes new file mode 100644 index 0000000..21cd6c6 --- /dev/null +++ b/Changes @@ -0,0 +1,4 @@ +Revision history for rgit + +0.01 2008-10-05 15:45 UTC + First version, released on an unsuspecting world. diff --git a/MANIFEST b/MANIFEST new file mode 100644 index 0000000..9b11f25 --- /dev/null +++ b/MANIFEST @@ -0,0 +1,38 @@ +Changes +MANIFEST +Makefile.PL +README +bin/rgit +lib/App/Rgit.pm +lib/App/Rgit/Command.pm +lib/App/Rgit/Command/Each.pm +lib/App/Rgit/Command/Once.pm +lib/App/Rgit/Config.pm +lib/App/Rgit/Config/Default.pm +lib/App/Rgit/Repository.pm +lib/App/Rgit/Utils.pm +t/00-load.t +t/15-failures.t +t/20-each.t +t/21-once.t +t/90-boilerplate.t +t/91-pod.t +t/92-pod-coverage.t +t/95-portability-files.t +t/99-kwalitee.t +t/bin/git +t/repos/01/a/.git/HEAD +t/repos/01/a/.git/objects/dummy +t/repos/01/a/.git/refs/dummy +t/repos/01/x/.git/refs/dummy +t/repos/02/b.git/HEAD +t/repos/02/b.git/objects/dummy +t/repos/02/b.git/refs/dummy +t/repos/02/x.git/refs/dummy +t/repos/02/x.git/objects/dummy +t/repos/03/x/c/.git/HEAD +t/repos/03/x/c/.git/objects/dummy +t/repos/03/x/c/.git/refs/dummy +t/repos/03/y/d.git/HEAD +t/repos/03/y/d.git/objects/dummy +t/repos/03/y/d.git/refs/dummy diff --git a/META.yml b/META.yml new file mode 100644 index 0000000..e7eabb3 --- /dev/null +++ b/META.yml @@ -0,0 +1,23 @@ +--- #YAML:1.0 +name: rgit +version: 0.01 +abstract: Recursively execute a command on all the git repositories in a directory tree. +license: perl +author: + - Vincent Pit +generated_by: ExtUtils::MakeMaker version 6.42 +distribution_type: module +requires: + Carp: 0 + Cwd: 0 + Exporter: 0 + File::Find: 0 + File::Spec::Functions: 0 + List::Util: 0 + Object::Tiny: 0 +meta-spec: + url: http://module-build.sourceforge.net/META-spec-v1.3.html + version: 1.3 +build_requires: + ExtUtils::MakeMaker: 0 + Test::More: 0 diff --git a/Makefile.PL b/Makefile.PL new file mode 100644 index 0000000..64d2531 --- /dev/null +++ b/Makefile.PL @@ -0,0 +1,46 @@ +use strict; +use warnings; +use ExtUtils::MakeMaker; + +my $BUILD_REQUIRES = { + 'Cwd' => 0, + 'ExtUtils::MakeMaker' => 0, + 'File::Spec::Functions' => 0, + 'File::Temp' => 0, + 'Test::More' => 0, +}; + +sub build_req { + my $tometa = ' >> $(DISTVNAME)/META.yml;'; + my $build_req = 'echo "build_requires:" ' . $tometa; + foreach my $mod ( sort { lc $a cmp lc $b } keys %$BUILD_REQUIRES ) { + my $ver = $BUILD_REQUIRES->{$mod}; + $build_req .= sprintf 'echo " %-30s %s" %s', "$mod:", $ver, $tometa; + } + return $build_req; +} + +WriteMakefile( + NAME => 'rgit', + AUTHOR => 'Vincent Pit ', + LICENSE => 'perl', + VERSION_FROM => 'lib/App/Rgit.pm', + ABSTRACT => 'Recursively execute a command on all the git repositories in a directory tree.', + PL_FILES => { }, + EXE_FILES => [ 'bin/rgit' ], + PREREQ_PM => { + 'Carp' => 0, + 'Cwd' => 0, + 'Exporter' => 0, + 'File::Find' => 0, + 'File::Spec::Functions' => 0, + 'List::Util' => 0, + 'Object::Tiny' => 0, + }, + dist => { + PREOP => 'pod2text bin/rgit > $(DISTVNAME)/README; ' + . build_req, + COMPRESS => 'gzip -9f', SUFFIX => 'gz' + }, + clean => { FILES => 'rgit-* *.gcov *.gcda *.gcno cover_db Debian_CPANTS.txt' } +); diff --git a/README b/README new file mode 100644 index 0000000..0404135 --- /dev/null +++ b/README @@ -0,0 +1,91 @@ +NAME + rgit - Recursively execute a command on all the git repositories in a + directory tree. + +VERSION + Version 0.01 + +SYNOPSIS + rgit [GIT_OPTIONS] COMMAND [COMMAND_ARGS] + +DESCRIPTION + This utility recursively searches in the current directory (or in the + directory given by the "GIT_DIR" environment variable if it's set) for + all git repositories, "chdir" into each of them, and executes the + specified git command. Moreover, those formats are substuted in the + arguments before running the command : + + * "^n" with the current repository name. + + * "^g" with the relative path to the current repository. + + * "^G" with the absolute path to the current repository. + + * "^w" with the relative path to the current repository's working + directory. + + * "^W" with the absolute path to the current repository's working + directory. + + * "^b" with a "bareified" relative path, i.e. "^g" if this is a bare + repository, and "^w.git" otherwise. + + * "^B" is the absolute version of the "bareified" path. + + * "^R" with the absolute path to the current root directory. + + * "^^" with a bare "^". + + There are actually a few commands that are only executed once in the + current directory : "version", "help", "daemon" and "init". For any of + those, no format substitution is done. + + You can specify which "git" executable to use with the "GIT_EXEC_PATH" + environment variable. + +EXAMPLES + Execute "git gc" on all the repositories below the current directory : + + rgit gc + + Tag all the repositories with their name : + + rgit tag ^n + + Add a remote to all repositories in "/foo/bar" to their bare counterpart + in "qux" on host : + + GIT_DIR="/foo/bar" rgit remote add host git://host/qux/^b + +DEPENDENCIES + The core modules Carp, Cwd, Exporter, File::Find, File::Spec::Functions + and List::Util. + + Object::Tiny. + +AUTHOR + Vincent Pit, "", . + + You can contact me by mail or on "irc.perl.org" (vincent). + +BUGS + Please report any bugs or feature requests to "bug-rgit at rt.cpan.org", + or through the web interface at + . I will be + notified, and then you'll automatically be notified of progress on your + bug as I make changes. + +SUPPORT + You can find documentation for this module with the perldoc command. + + perldoc rgit + + Tests code coverage report is available at + . + +COPYRIGHT & LICENSE + Copyright 2008 Vincent Pit, all rights reserved. + + This program is free software; you can redistribute it and/or modify it + under the same terms as Perl itself. + diff --git a/bin/rgit b/bin/rgit new file mode 100755 index 0000000..6b45da5 --- /dev/null +++ b/bin/rgit @@ -0,0 +1,148 @@ +#!/usr/bin/perl + +use strict; +use warnings; + +use Carp qw/croak/; +use Cwd qw/cwd/; +use File::Spec::Functions qw/catfile path/; +use List::Util qw/first/; + +use App::Rgit; + +our $VERSION = '0.01'; + +my $cmd = first { !/^-/ } @ARGV; +$cmd = ' ' unless defined $cmd; + +my $git = $ENV{GIT_EXEC_PATH}; +unless (defined $git) { + for (path) { + my $g = catfile $_, 'git'; + if (-x $g) { + $git = $g; + last; + } + } +} +croak "Couldn't find any valid git executable" unless defined $git; + +my $root = $ENV{GIT_DIR}; +$root = cwd unless defined $root; + +exit App::Rgit->new( + git => $git, + root => $root, + cmd => $cmd, + args => \@ARGV +)->run; + +__END__ + +=head1 NAME + +rgit - Recursively execute a command on all the git repositories in a directory tree. + +=head1 VERSION + +Version 0.01 + +=head1 SYNOPSIS + + rgit [GIT_OPTIONS] COMMAND [COMMAND_ARGS] + +=head1 DESCRIPTION + +This utility recursively searches in the current directory (or in the directory given by the C environment variable if it's set) for all git repositories, C into each of them, and executes the specified git command. +Moreover, those formats are substuted in the arguments before running the command : + +=over 4 + +=item * + +C<^n> with the current repository name. + +=item * + +C<^g> with the relative path to the current repository. + +=item * + +C<^G> with the absolute path to the current repository. + +=item * + +C<^w> with the relative path to the current repository's working directory. + +=item * + +C<^W> with the absolute path to the current repository's working directory. + +=item * + +C<^b> with a "bareified" relative path, i.e. C<^g> if this is a bare repository, and C<^w.git> otherwise. + +=item * + +C<^B> is the absolute version of the "bareified" path. + +=item * + +C<^R> with the absolute path to the current root directory. + +=item * + +C<^^> with a bare C<^>. + +=back + +There are actually a few commands that are only executed once in the current directory : C, C, C and C. +For any of those, no format substitution is done. + +You can specify which C executable to use with the C environment variable. + +=head1 EXAMPLES + +Execute C on all the repositories below the current directory : + + rgit gc + +Tag all the repositories with their name : + + rgit tag ^n + +Add a remote to all repositories in "/foo/bar" to their bare counterpart in C on F : + + GIT_DIR="/foo/bar" rgit remote add host git://host/qux/^b + +=head1 DEPENDENCIES + +The core modules L, L, L, L, L and L. + +L. + +=head1 AUTHOR + +Vincent Pit, C<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc rgit + +Tests code coverage report is available at L. + +=head1 COPYRIGHT & LICENSE + +Copyright 2008 Vincent Pit, all rights reserved. + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut diff --git a/lib/App/Rgit.pm b/lib/App/Rgit.pm new file mode 100644 index 0000000..f84d445 --- /dev/null +++ b/lib/App/Rgit.pm @@ -0,0 +1,106 @@ +package App::Rgit; + +use strict; +use warnings; + +use Cwd qw/abs_path/; +use File::Spec::Functions qw/file_name_is_absolute/; + +use Object::Tiny qw/config command/; + +use App::Rgit::Command; +use App::Rgit::Config; +use App::Rgit::Utils qw/validate/; + +=head1 NAME + +App::Rgit - Backend that supports the rgit utility. + +=head1 VERSION + +Version 0.01 + +=cut + +our $VERSION = '0.01'; + +=head1 DESCRIPTION + +Backend that supports the L utility. + +This is an internal class to L. + +=head1 METHODS + +=head2 C<< new root => $root, git => $git, cmd => $cmd, args => \@args >> + +Creates a new L object that's bound to execute the command C<$cmd> on all the C repositories inside C<$root> with C<@args> as arguments and C<$git> as C executable. + +=cut + +sub new { + my ($class, %args) = &validate; + my $root = $args{root}; + return unless defined $root and -d $root; + $root = abs_path $root unless file_name_is_absolute $root; + return unless defined $args{git} and -x $args{git}; + my $config = App::Rgit::Config->new( + root => $root, + git => $args{git}, + ); + $class->SUPER::new( + config => $config, + command => App::Rgit::Command->new( + cmd => $args{cmd} || ' ', + args => $args{args}, + repos => $config->repos, + ) + ); +} + +=head2 C + +Actually run the commands. + +=cut + +sub run { + my $self = shift; + $self->command->run($self->config); +} + +=head2 C + +=head2 C + +Accessors. + +=head1 SEE ALSO + +L. + +=head1 AUTHOR + +Vincent Pit, C<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc App::Rgit + +=head1 COPYRIGHT & LICENSE + +Copyright 2008 Vincent Pit, all rights reserved. + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; # End of App::Rgit diff --git a/lib/App/Rgit/Command.pm b/lib/App/Rgit/Command.pm new file mode 100644 index 0000000..b32095f --- /dev/null +++ b/lib/App/Rgit/Command.pm @@ -0,0 +1,127 @@ +package App::Rgit::Command; + +use strict; +use warnings; + +use Carp qw/croak/; + +use Object::Tiny qw/cmd cwd_as_repo args repos/; + +use App::Rgit::Utils qw/validate/; +use App::Rgit::Repository; + +=head1 NAME + +App::Rgit::Command - Base class for App::Rgit commands. + +=head1 VERSION + +Version 0.01 + +=cut + +our $VERSION = '0.01'; + +=head1 DESCRIPTION + +Base class for L commands. + +This is an internal class to L. + +=head1 METHODS + +=head2 C<< new cmd => $cmd, args => \@args, repos => \@repos >> + +Creates a new command object for C<$cmd> that will called for all repositories C<@repos> with arguments C<@args>. + +=cut + +my %commands; +__PACKAGE__->action($_ => 'Once') for qw/version help daemon init/, ' '; + +sub new { + my ($class, %args) = &validate; + my $cmd = $args{cmd}; + return unless defined $cmd; + my $action = $class->action($cmd); + croak "Command $cmd shouldn't be executed as an $action" + unless $class eq __PACKAGE__ or $class->isa($action); + my @repos = grep $_->isa('App::Rgit::Repository'), + ref $args{repos} eq 'ARRAY' ? @{$args{repos}} : $args{repos}; + eval "require $action; 1" or croak "Couldn't load $action: $@"; + my $r = App::Rgit::Repository->new(fake => 1); + return unless defined $r; + $action->SUPER::new( + cmd => $cmd, + args => $args{args} || [ ], + repos => \@repos, + cwd_as_repo => $r, + ); +} + +=head2 C<< action $cmd [ => $pkg ] >> + +If C<$pkg> is supplied, handles command C<$cmd> with C<$pkg> objects. +Otherwise, returns the current class for C<$cmd>. + +=cut + +sub action { + my ($self, $cmd, $pkg) = @_; + $cmd = $self->cmd if !defined $cmd + and defined $self and $self->isa(__PACKAGE__); + return unless defined $cmd; + unless (defined $pkg) { + return __PACKAGE__ . '::Each' unless defined $commands{$cmd}; + return $commands{$cmd} + } + $pkg = __PACKAGE__ . '::' . $pkg unless $pkg =~ /:/; + $commands{$cmd} = $pkg; +} + +=head2 C + +=head2 C + +=head2 C + +=head2 C + +Accessors. + +=head2 C + +Runs the command with a L configuration object. +Stops as soon as one of the executed commands fails, and returns the corresponding exit code. +Returns zero when all went fine. +Implemented in subclasses. + +=head1 SEE ALSO + +L. + +=head1 AUTHOR + +Vincent Pit, C<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc App::Rgit::Command + +=head1 COPYRIGHT & LICENSE + +Copyright 2008 Vincent Pit, all rights reserved. + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; # End of App::Rgit::Command diff --git a/lib/App/Rgit/Command/Each.pm b/lib/App/Rgit/Command/Each.pm new file mode 100644 index 0000000..2981904 --- /dev/null +++ b/lib/App/Rgit/Command/Each.pm @@ -0,0 +1,76 @@ +package App::Rgit::Command::Each; + +use strict; +use warnings; + +use base qw/App::Rgit::Command/; + +=head1 NAME + +App::Rgit::Command::Each - Class for commands to execute for each repository. + +=head1 VERSION + +Version 0.01 + +=cut + +our $VERSION = '0.01'; + +=head1 DESCRIPTION + +Class for commands to execute for each repository. + +This is an internal class to L. + +=head1 METHODS + +This class inherits from L. + +It implements : + +=head2 C + +=cut + +sub run { + my $self = shift; + my $status = 0; + for (@{$self->repos}) { + $_->chdir or next; + $status = $_->run($_[0], @{$self->args}); + last if $status; + } + $self->cwd_as_repo->chdir; + return $status; +} + +=head1 SEE ALSO + +L. + +=head1 AUTHOR + +Vincent Pit, C<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc App::Rgit::Command::Each + +=head1 COPYRIGHT & LICENSE + +Copyright 2008 Vincent Pit, all rights reserved. + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; # End of App::Rgit::Command::Each diff --git a/lib/App/Rgit/Command/Once.pm b/lib/App/Rgit/Command/Once.pm new file mode 100644 index 0000000..f602ef1 --- /dev/null +++ b/lib/App/Rgit/Command/Once.pm @@ -0,0 +1,69 @@ +package App::Rgit::Command::Once; + +use strict; +use warnings; + +use base qw/App::Rgit::Command/; + +=head1 NAME + +App::Rgit::Command::Once - Class for commands to execute only once. + +=head1 VERSION + +Version 0.01 + +=cut + +our $VERSION = '0.01'; + +=head1 DESCRIPTION + +Class for commands to execute only once. + +This is an internal class to L. + +=head1 METHODS + +This class inherits from L. + +It implements : + +=head2 C + +=cut + +sub run { + my ($self, $conf) = @_; + $self->cwd_as_repo->run($conf, @{$self->args}); +} + +=head1 SEE ALSO + +L. + +=head1 AUTHOR + +Vincent Pit, C<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc App::Rgit::Command::Once + +=head1 COPYRIGHT & LICENSE + +Copyright 2008 Vincent Pit, all rights reserved. + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; # End of App::Rgit::Command::Once diff --git a/lib/App/Rgit/Config.pm b/lib/App/Rgit/Config.pm new file mode 100644 index 0000000..20ef223 --- /dev/null +++ b/lib/App/Rgit/Config.pm @@ -0,0 +1,80 @@ +package App::Rgit::Config; + +use strict; +use warnings; + +use Carp qw/croak/; + +use Object::Tiny qw/root git/; + +use App::Rgit::Utils qw/validate/; + +=head1 NAME + +App::Rgit::Config - Base class for App::Rgit configurations. + +=head1 VERSION + +Version 0.01 + +=head1 DESCRIPTION + +Base class for L configurations. + +This is an internal class to L. + +=head1 METHODS + +=head2 C<< new root => $root, git => $git >> + +Creates a new configuration object based on the root directory C<$root> and using C<$git> as F executable. + +=cut + +sub new { + my ($class, %args) = &validate; + my $conf = 'App::Rgit::Config::Default'; + eval "require $conf; 1" or croak "Couldn't load $conf: $@"; + $conf->SUPER::new( + root => $args{root}, + git => $args{git}, + ); +} + +=head2 C + +=head2 C + +=head2 C + +Accessors. + +=head1 SEE ALSO + +L. + +=head1 AUTHOR + +Vincent Pit, C<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc App::Rgit::Config + +=head1 COPYRIGHT & LICENSE + +Copyright 2008 Vincent Pit, all rights reserved. + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; # End of App::Rgit::Config diff --git a/lib/App/Rgit/Config/Default.pm b/lib/App/Rgit/Config/Default.pm new file mode 100644 index 0000000..5917d79 --- /dev/null +++ b/lib/App/Rgit/Config/Default.pm @@ -0,0 +1,85 @@ +package App::Rgit::Config::Default; + +use strict; +use warnings; + +use File::Find qw/find/; + +use base qw/App::Rgit::Config/; + +use App::Rgit::Repository; + +=head1 NAME + +App::Rgit::Config::Default - Default App::Rgit configuration class. + +=head1 VERSION + +Version 0.01 + +=cut + +our $VERSION = '0.01'; + +=head1 DESCRIPTION + +Default L configuration class. + +This is an internal class to L. + +=head1 METHODS + +This class inherits from L. + +It implements : + +=head2 C + +=cut + +sub repos { + my $self = shift; + return $self->{repos} if defined $self->{repos}; + my %repos; + find { + wanted => sub { + return unless -d $_; + return if $_ eq '.' or $_ eq '..'; + my $r = App::Rgit::Repository->new(dir => $File::Find::name); + $repos{$r->repo} = $r if $r + and not exists $repos{$r->repo}; + }, + follow => 1 + }, $self->root; + $self->{repos} = [ values %repos ]; +} + +=head1 SEE ALSO + +L. + +=head1 AUTHOR + +Vincent Pit, C<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc App::Rgit::Command::Default + +=head1 COPYRIGHT & LICENSE + +Copyright 2008 Vincent Pit, all rights reserved. + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; # End of App::Rgit::Command::Default diff --git a/lib/App/Rgit/Repository.pm b/lib/App/Rgit/Repository.pm new file mode 100644 index 0000000..93efb4c --- /dev/null +++ b/lib/App/Rgit/Repository.pm @@ -0,0 +1,172 @@ +package App::Rgit::Repository; + +use strict; +use warnings; + +use Cwd qw/cwd abs_path/; +use File::Spec::Functions qw/catdir splitdir abs2rel/; + +use Object::Tiny qw/fake repo bare name work/; + +use App::Rgit::Utils qw/validate/; + +=head1 NAME + +App::Rgit::Repository - Class representing a Git repository. + +=head1 VERSION + +Version 0.01 + +=cut + +our $VERSION = '0.01'; + +=head1 DESCRIPTION + +Class representing a Git repository. + +This is an internal class to L. + +=head1 METHODS + +=head2 C<< new dir => $dir [, fake => 1 ] >> + +Creates a new repository starting from C<$dir>. +If the C option is passed, C<$dir> isn't checked to be a valid C repository. + +=cut + +sub new { + my ($class, %args) = &validate; + my $dir = $args{dir}; + $dir = abs_path $dir if defined $dir; + $dir = cwd unless defined $dir; + my ($repo, $bare, $name, $work); + if ($args{fake}) { + $repo = $dir; + } else { + my @tries = ($dir); + push @tries, "$dir.git" unless $dir =~ /\.git$/; + push @tries, catdir($dir, '.git') unless $dir eq '.git'; + for (@tries) { + if (-d $_ && -d "$_/refs" and -d "$_/objects" and -e "$_/HEAD") { + $repo = $_; + last; + } + } + return unless defined $repo; + my @chunks = splitdir($repo); + my $last = pop @chunks; + if ($last eq '.git') { + $bare = 0; + $name = $chunks[-1]; + $work = catdir(@chunks); + } else { + $bare = 1; + ($name) = $last =~ /(.*)\.git$/; + $work = $repo; + } + } + $class->SUPER::new( + fake => !!$args{fake}, + repo => $repo, + bare => $bare, + name => $name, + work => $work, + ); +} + +=head2 C + +C into the repository's directory. + +=cut + +sub chdir { + my $self = shift; + my $repo = $self->repo; + chdir $repo or do { + warn "Couldn't chdir into $repo: $!"; + return; + }; + return 1; +} + +=head2 C + +Runs C on the repository for the L configuration C<$conf>. +When the repository isn't fake, the format substitutions applies to C<@args> elements. +Returns the exit code. + +=cut + +sub _abs2rel { + my $a = &abs2rel; + $a = $_[0] unless defined $a; + $a; +} + +sub run { + my $self = shift; + my $conf = shift; + return unless $conf->isa('App::Rgit::Config'); + my @args = @_; + unless ($self->fake) { + my %escapes = ( + '^' => sub { '^' }, + 'n' => sub { $self->name }, + 'g' => sub { _abs2rel($self->repo, $conf->root) }, + 'G' => sub { $self->repo }, + 'w' => sub { _abs2rel($self->work, $conf->root) }, + 'W' => sub { $self->work }, + 'b' => sub { _abs2rel($self->bare ? $self->repo : $self->work . '.git', $conf->root) }, + 'B' => sub { $self->bare ? $self->repo : $self->work . '.git' }, + 'R' => sub { $conf->root }, + ); + s/\^([\^ngGwWbBR])/$escapes{$1}->()/eg for @args; + } + system { $conf->git } $conf->git, @args; +} + +=head2 C + +=head2 C + +=head2 C + +=head2 C + +=head2 C + +Accessors. + +=head1 SEE ALSO + +L. + +=head1 AUTHOR + +Vincent Pit, C<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc App::Rgit::Repository + +=head1 COPYRIGHT & LICENSE + +Copyright 2008 Vincent Pit, all rights reserved. + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; # End of App::Rgit::Repository diff --git a/lib/App/Rgit/Utils.pm b/lib/App/Rgit/Utils.pm new file mode 100644 index 0000000..646a81e --- /dev/null +++ b/lib/App/Rgit/Utils.pm @@ -0,0 +1,85 @@ +package App::Rgit::Utils; + +use strict; +use warnings; + +use Carp qw/croak/; + +=head1 NAME + +App::Rgit::Utils - Miscellanous utilities for App::Rgit classes. + +=head1 VERSION + +Version 0.01 + +=cut + +our $VERSION = '0.01'; + +=head1 DESCRIPTION + +Miscellanous utilities for L classes. + +This is an internal module to L. + +=head1 FUNCTIONS + +=head2 C + +Sanitize arguments passed to methods. + +=cut + +sub validate { + my $class = shift; + croak 'Optional arguments must be passed as key/value pairs' if @_ % 2; + $class = ref($class) || $class; + $class = caller unless $class; + return $class, @_; +} + +=head1 EXPORT + +C is only exported on request. + +=cut + +use base qw/Exporter/; + +our @EXPORT = (); +our %EXPORT_TAGS = ( + funcs => [ qw/validate/ ] +); +our @EXPORT_OK = map { @$_ } values %EXPORT_TAGS; +$EXPORT_TAGS{'all'} = [ @EXPORT_OK ]; + +=head1 SEE ALSO + +L. + +=head1 AUTHOR + +Vincent Pit, C<< >>, L. + +You can contact me by mail or on C (vincent). + +=head1 BUGS + +Please report any bugs or feature requests to C, or through the web interface at L. I will be notified, and then you'll automatically be notified of progress on your bug as I make changes. + +=head1 SUPPORT + +You can find documentation for this module with the perldoc command. + + perldoc App::Rgit::Utils + +=head1 COPYRIGHT & LICENSE + +Copyright 2008 Vincent Pit, all rights reserved. + +This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. + +=cut + +1; # End of App::Rgit::Utils diff --git a/t/00-load.t b/t/00-load.t new file mode 100644 index 0000000..8e32fcd --- /dev/null +++ b/t/00-load.t @@ -0,0 +1,15 @@ +#!perl -T + +use strict; +use warnings; + +use Test::More tests => 4; + +BEGIN { + use_ok( 'App::Rgit' ); + use_ok( 'App::Rgit::Command' ); + use_ok( 'App::Rgit::Command::Each' ); + use_ok( 'App::Rgit::Command::Once' ); +} + +diag( "Testing App::Rgit $App::Rgit::VERSION, Perl $], $^X" ); diff --git a/t/15-failures.t b/t/15-failures.t new file mode 100644 index 0000000..6b823fe --- /dev/null +++ b/t/15-failures.t @@ -0,0 +1,45 @@ +#!perl + +use strict; +use warnings; + +use Test::More tests => 17; + +use App::Rgit; + +local $SIG{__WARN__} = sub { die @_ }; + +eval { App::Rgit->new(qw/foo bar baz/) }; +like($@, qr!Optional\s+arguments\s+must\s+be\s+passed\s+as\s+keys?\s*/\s*values?\s+pairs?!, 'App::Rgit->new(even): croaks'); + +my $res = eval { App::Rgit->new() }; +is($@, '', 'App::Rgit->new(): no root: does not croak'); +is($res, undef, 'App::Rgit->new(): no root: returns undef'); + +$res = eval { App::Rgit->new(root => $0) }; +is($@, '', 'App::Rgit->new(): wrong root: does not croak'); +is($res, undef, 'App::Rgit->new(): wrong root: returns undef'); + +$res = eval { App::Rgit->new(root => 't/repos') }; +is($@, '', 'App::Rgit->new(): no git: does not croak'); +is($res, undef, 'App::Rgit->new(): no git: returns undef'); + +$res = eval { App::Rgit->new(root => 't/repos', git => $0) }; +is($@, '', 'App::Rgit->new(): wrong git: does not croak'); +is($res, undef, 'App::Rgit->new(): wrong git: returns undef'); + +$res = eval { App::Rgit->new(root => 't/repos', git => 't/bin/git') }; +is($@, '', 'App::Rgit->new(): no cmd: does not croak'); +isa_ok($res, 'App::Rgit', 'App::Rgit->new(): no cmd: returns an object'); + +$res = eval { App::Rgit->new(root => 't/repos', git => 't/bin/git', cmd => 'version'); }; +is($@, '', 'App::Rgit->new(): no args: does not croak'); +isa_ok($res, 'App::Rgit', 'App::Rgit->new(): no args: returns an object'); + +$res = eval { $res->new(root => 't/repos', git => 't/bin/git', cmd => 'version'); }; +is($@, '', '$ar->new(): no args: does not croak'); +isa_ok($res, 'App::Rgit', '$ar->new(): no args: returns an object'); + +$res = eval { App::Rgit::new(undef, root => 't/repos', git => 't/bin/git', cmd => 'version'); }; +is($@, '', 'undef->App::Rgit::new(): no args: does not croak'); +isa_ok($res, 'App::Rgit','undef->App::Rgit::new(): no args: returns an object'); diff --git a/t/20-each.t b/t/20-each.t new file mode 100644 index 0000000..12223f6 --- /dev/null +++ b/t/20-each.t @@ -0,0 +1,49 @@ +#!perl + +use strict; +use warnings; + +use Cwd qw/cwd abs_path/; +use File::Spec::Functions qw/catdir/; +use File::Temp qw/tempfile/; + +use Test::More tests => 3 * 2; + +use App::Rgit; + +my $n = 3; + +my @expected = ( + undef, + [ [ 'a', 'a/.git', 'a', 'a.git' ] ], + [ [ 'b', 'b.git', 'b.git', 'b.git' ] ], + [ + [ 'c', 'x/c/.git', 'x/c', 'x/c.git' ], + [ 'd', 'y/d.git', 'y/d.git', 'y/d.git' ], + ], +); + +my $cwd = cwd; +my @repos = (undef, + map { catdir $cwd, 't', 'repos', sprintf("%02d", $_) } 1 .. $n); +for my $i (1 .. $n) { + for my $a (@{$expected[$i]}) { + $a->[$_+3] = catdir($repos[$i], $a->[$_]) for 1 .. 3; + push @$a, $repos[$i], '^'; + } +} + +for (1 .. $n) { + my ($fh, $filename) = tempfile(UNLINK => 1); + my $exit = App::Rgit->new( + git => abs_path('t/bin/git'), + root => $repos[$_], + cmd => 'commit', + args => [ abs_path($filename), 'commit', qw/^n ^g ^w ^b ^G ^W ^B ^R ^^/ ] + )->run; + is($exit, 0, "each $_ returned 0"); + my @lines = sort split /\n/, do { local $/; <$fh> }; + my $res = [ map [ split /\|/, $_ ], @lines ]; + my $exp = [ map [ 'commit', @$_ ], @{$expected[$_]} ]; + is_deeply($res, $exp, "each $_ did the right thing"); +} diff --git a/t/21-once.t b/t/21-once.t new file mode 100644 index 0000000..cf79046 --- /dev/null +++ b/t/21-once.t @@ -0,0 +1,30 @@ +#!perl + +use strict; +use warnings; + +use Cwd qw/abs_path/; +use File::Temp qw/tempfile/; + +use Test::More tests => 4 * 2; + +use App::Rgit; + +my @expected = ( + ([ [ qw/^n ^g ^w ^b ^^/ ] ]) x 4 +); + +for (qw/version help daemon init/) { + my ($fh, $filename) = tempfile(UNLINK => 1); + my $exit = App::Rgit->new( + git => abs_path('t/bin/git'), + root => 't/repos', + cmd => $_, + args => [ abs_path($filename), $_, qw/^n ^g ^w ^b ^^/ ] + )->run; + is($exit, 0, "each $_ returned 0"); + my @lines = sort split /\n/, do { local $/; <$fh> }; + my $res = [ map [ split /\|/, $_ ], @lines ]; + my $exp = [ [ $_, qw/^n ^g ^w ^b ^^/ ] ]; + is_deeply($res, $exp, "each $_ did the right thing"); +} diff --git a/t/90-boilerplate.t b/t/90-boilerplate.t new file mode 100644 index 0000000..189380e --- /dev/null +++ b/t/90-boilerplate.t @@ -0,0 +1,56 @@ +#!perl -T + +use strict; +use warnings; + +use Test::More tests => 10; + +sub not_in_file_ok { + my ($filename, %regex) = @_; + open( my $fh, '<', $filename ) + or die "couldn't open $filename for reading: $!"; + + my %violated; + + while (my $line = <$fh>) { + while (my ($desc, $regex) = each %regex) { + if ($line =~ $regex) { + push @{$violated{$desc}||=[]}, $.; + } + } + } + + if (%violated) { + fail("$filename contains boilerplate text"); + diag "$_ appears on lines @{$violated{$_}}" for keys %violated; + } else { + pass("$filename contains no boilerplate text"); + } +} + +sub module_boilerplate_ok { + my ($module) = @_; + not_in_file_ok($module => + 'the great new $MODULENAME' => qr/ - The great new /, + 'boilerplate description' => qr/Quick summary of what the module/, + 'stub function definition' => qr/function[12]/, + ); +} + +not_in_file_ok(README => + "The README is used..." => qr/The README is used/, + "'version information here'" => qr/to provide version information/, +); + +not_in_file_ok(Changes => + "placeholder date/time" => qr(Date/time) +); + +module_boilerplate_ok('lib/App/Rgit.pm'); +module_boilerplate_ok('lib/App/Rgit/Command.pm'); +module_boilerplate_ok('lib/App/Rgit/Command/Each.pm'); +module_boilerplate_ok('lib/App/Rgit/Command/Once.pm'); +module_boilerplate_ok('lib/App/Rgit/Config.pm'); +module_boilerplate_ok('lib/App/Rgit/Config/Default.pm'); +module_boilerplate_ok('lib/App/Rgit/Repository.pm'); +module_boilerplate_ok('lib/App/Rgit/Utils.pm'); diff --git a/t/91-pod.t b/t/91-pod.t new file mode 100644 index 0000000..62d2d7f --- /dev/null +++ b/t/91-pod.t @@ -0,0 +1,13 @@ +#!perl -T + +use strict; +use warnings; + +use Test::More; + +# Ensure a recent version of Test::Pod +my $min_tp = 1.22; +eval "use Test::Pod $min_tp"; +plan skip_all => "Test::Pod $min_tp required for testing POD" if $@; + +all_pod_files_ok(); diff --git a/t/92-pod-coverage.t b/t/92-pod-coverage.t new file mode 100644 index 0000000..3037c13 --- /dev/null +++ b/t/92-pod-coverage.t @@ -0,0 +1,19 @@ +#!perl -T + +use strict; +use warnings; + +use Test::More; + +# Ensure a recent version of Test::Pod::Coverage +my $min_tpc = 1.08; +eval "use Test::Pod::Coverage $min_tpc"; +plan skip_all => "Test::Pod::Coverage $min_tpc required for testing POD coverage" if $@; + +# Test::Pod::Coverage doesn't require a minimum Pod::Coverage version, +# but older versions don't recognize some common documentation styles +my $min_pc = 0.18; +eval "use Pod::Coverage $min_pc"; +plan skip_all => "Pod::Coverage $min_pc required for testing POD coverage" if $@; + +all_pod_coverage_ok(); diff --git a/t/95-portability-files.t b/t/95-portability-files.t new file mode 100644 index 0000000..ab541f3 --- /dev/null +++ b/t/95-portability-files.t @@ -0,0 +1,10 @@ +#!perl -T + +use strict; +use warnings; + +use Test::More; + +eval "use Test::Portability::Files"; +plan skip_all => "Test::Portability::Files required for testing filenames portability" if $@; +run_tests(); diff --git a/t/99-kwalitee.t b/t/99-kwalitee.t new file mode 100644 index 0000000..7775e60 --- /dev/null +++ b/t/99-kwalitee.t @@ -0,0 +1,9 @@ +#!perl + +use strict; +use warnings; + +use Test::More; + +eval { require Test::Kwalitee; Test::Kwalitee->import() }; +plan( skip_all => 'Test::Kwalitee not installed; skipping' ) if $@; diff --git a/t/bin/git b/t/bin/git new file mode 100755 index 0000000..6d769f6 --- /dev/null +++ b/t/bin/git @@ -0,0 +1,9 @@ +#!/usr/bin/env perl + +# This has to work with olde perls + +my $filename = shift @ARGV; +open FH, ">>$filename" or die "open($filename): $!"; +print FH join '|', @ARGV; +print FH "\n"; +close FH; diff --git a/t/repos/02/b.git/HEAD b/t/repos/02/b.git/HEAD new file mode 100644 index 0000000..e69de29 diff --git a/t/repos/02/b.git/objects/dummy b/t/repos/02/b.git/objects/dummy new file mode 100644 index 0000000..e69de29 diff --git a/t/repos/02/b.git/refs/dummy b/t/repos/02/b.git/refs/dummy new file mode 100644 index 0000000..e69de29 diff --git a/t/repos/02/x.git/objects/dummy b/t/repos/02/x.git/objects/dummy new file mode 100644 index 0000000..e69de29 diff --git a/t/repos/02/x.git/refs/dummy b/t/repos/02/x.git/refs/dummy new file mode 100644 index 0000000..e69de29 diff --git a/t/repos/03/y/d.git/HEAD b/t/repos/03/y/d.git/HEAD new file mode 100644 index 0000000..e69de29 diff --git a/t/repos/03/y/d.git/objects/dummy b/t/repos/03/y/d.git/objects/dummy new file mode 100644 index 0000000..e69de29 diff --git a/t/repos/03/y/d.git/refs/dummy b/t/repos/03/y/d.git/refs/dummy new file mode 100644 index 0000000..e69de29