App-GitHub-FixRepositoryName
view release on metacpan or search on metacpan
github-fix-repository-name My-Repository/ # ...should contain a .git directory
cd .git; github-fix-repository
# All of the above do the same thing, basically
DESCRIPTION
App::GitHub::FixRepositoryName will automatically find and update the
github repository URLs in .git/config (so that they have the right
casing). It will first make a backup of your .git/config AND it will
prompt you before writing out the new config (and show it to you first)
INSTALL
You can install App::GitHub::FixRepositoryName by using CPAN:
cpan -i App::GitHub::FixRepositoryName
If that doesn't work properly, you can find help at:
http://sial.org/howto/perl/life-with-cpan/
git clone git://github.com/robertkrimen/App-GitHub-FixRepositoryName.git
USAGE
github-fix-repository-name
A commandline application that will fix a given .git/config to have the
right repository name(s)
Usage: github-fix-repository-name [...] <path1> <path2> ...
--backup-to <directory> Backup 'config' to <directory> (default is the same directory)
--no-backup Do not make a backup first
--always-yes Assume yes when asking to write out the new config
--help, -h, -? This help
For example:
github-fix-repository-name .git/config
github-fix-repository-name My-Project1 xyzzy/My-Project2 # Fix many at once
lib/App/GitHub/FixRepositoryName.pm view on Meta::CPAN
github-fix-repository-name My-Repository/ # ...should contain a .git directory
cd .git; github-fix-repository
# All of the above do the same thing, basically
=head1 DESCRIPTION
App::GitHub::FixRepositoryName will automatically find and update the github repository URLs in .git/config (so that they have
the right casing). It will first make a backup of your .git/config AND it will prompt you before writing out
the new config (and show it to you first)
=head1 INSTALL
You can install L<App::GitHub::FixRepositoryName> by using L<CPAN>:
cpan -i App::GitHub::FixRepositoryName
If that doesn't work properly, you can find help at:
lib/App/GitHub/FixRepositoryName.pm view on Meta::CPAN
=cut
=head1 USAGE
=head2 github-fix-repository-name
A commandline application that will fix a given .git/config to have the right repository name(s)
Usage: github-fix-repository-name [...] <path1> <path2> ...
--backup-to <directory> Backup 'config' to <directory> (default is the same directory)
--no-backup Do not make a backup first
--always-yes Assume yes when asking to write out the new config
--help, -h, -? This help
For example:
github-fix-repository-name .git/config
github-fix-repository-name My-Project1 xyzzy/My-Project2 # Fix many at once
lib/App/GitHub/FixRepositoryName.pm view on Meta::CPAN
return $url; # Put back what we originally had
}
sub do_usage(;$) {
my $error = shift;
warn $error if $error;
warn <<'_END_';
Usage: github-fix-repository-name [...] <path>
--backup-to <directory> Backup 'config' to <directory> (default is the same directory)
--no-backup Do not make a backup first
--always-yes Assume yes when asking to write out the new config
--help, -h, -? This help
For example:
github-fix-repository-name .git/config
_END_
exit -1 if $error;
}
sub run {
my $self = shift;
my ($backup_to, $no_backup, $always_yes, $help);
GetOptions(
'help|h|?' => \$help,
'backup-to=s' => \$backup_to,
'no-backup' => \$no_backup,
'always-yes|Y' => \$always_yes,
);
if ($help) {
do_usage;
exit 0;
}
my @fix = @ARGV ? @ARGV : qw/./;
for my $path (@fix) {
$self->_try_to_fix_file_or_directory( $path,
backup_to => $backup_to, no_backup => $no_backup, always_yes => $always_yes );
}
}
sub _try_to_fix_file_or_directory {
my $self = shift;
my $path = shift;
my %given = @_;
my $silent = $given{silent};
my $print = $silent ? sub {} : sub { print @_ };
lib/App/GitHub/FixRepositoryName.pm view on Meta::CPAN
}
croak "Can't read file \"$file\"" unless -r $file;
croak "Can't write file \"$file\"" unless -w _;
if (! -s _ ) {
carp "File \"$file\" is empty";
return;
}
my ($backup_file);
my ($content, $original_content) = $self->fix_file( $file );
if ($content eq $original_content) {
$print->( "Nothing to do to \"$file\"\n" );
return;
}
else {
$print->( $content );
$print->( "\n" ) unless $content =~ m/\n$/;
$print->( "---\n" );
unless ($given{always_yes}) {
my $Y = prompt( 'Y', "Do you want to write out the new .git/config to:\n\n$file\n\n? Y/n", 'Enter y or n', 'Y' );
unless ($Y) {
$print->( "Abandoning update to \"$file\"\n" );
return;
}
}
unless ( $given{no_backup} ) {
$backup_file = $self->_backup_file( $file, to => $given{backup_to}, template => $given{backup_template} );
$print->( "Made a backup of \"$file\" to \"$backup_file\"\n" );
}
File::AtomicWrite->write_file({ file => $file, input => \$content });
$print->( "Fixup of \"$file\" complete\n" );
$file = Path::Class::File->new( "$file" );
return wantarray ? ($file, $backup_file) : $file;
}
}
# TODO: Factor this out to a CPAN module
sub _backup_file {
my $self = shift;
my $file = shift;
my %given = @_;
croak "Wasn't given file to backup" unless defined $file;
croak "Can't read file \"$file\"" unless -r $file;
$file = Path::Class::File->new( "$file" );
my $to = $given{to} || $file->parent;
$to = Path::Class::Dir->new( "$to" );
$to->mkpath unless -e $to;
croak "Backup destination \"$to\" is not a directory (or doesn't exist)" unless -d $to;
croak "Cannot write to backup destination \"$to\"" unless -w _;
my $template = $given{template} || '.backup-%basename-%date-%tmp';
if ($template =~ m/%fullpath\b/) {
my $value = $file.'';
$value =~ s!/+!-!g;
$template =~ s/%fullpath\b/$value/g;
}
if ($template =~ m/%basename\b/) {
my $value = $file->basename;
$template =~ s/%basename\b/$value/g;
lib/App/GitHub/FixRepositoryName.pm view on Meta::CPAN
$tmp = 1;
my $value = "XXXXXX";
$template =~ s/%tmp\b/$value/g;
}
if ($template =~ m/%sha1\b/) {
my $value = sha1_hex scalar $file->slurp;
$template =~ s/%sha1\b/$value/g;
}
my ($handle, $backup_file);
if ($tmp) {
($handle, $backup_file) = tempfile( $template, DIR => "$to", UNLINK => 0 );
}
else {
$backup_file = $to->file( $template );
$handle = $backup_file->openw or croak "Couldn't open \"$backup_file\": since $!";
}
$handle->print( scalar $file->slurp );
close $handle;
my $file_size = -s $file;
my $backup_file_size = -s $backup_file;
croak "Couldn't backup \"$file\" ($file_size) to \"$backup_file\" ($backup_file_size): size doesn't match!" unless $file_size == $backup_file_size;
return Path::Class::File->new( $backup_file );
}
=head1 AUTHOR
Robert Krimen, C<< <rkrimen at cpan.org> >>
=head1 BUGS
Please report any bugs or feature requests to C<bug-app-github-fixrepositoryname at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=App-GitHub-FixRepositoryName>. I will be notified, and then you'll
t/01-basic.t view on Meta::CPAN
sub sha1_file($) {
my $file = shift;
return sha1_hex scalar $file->slurp;
}
my $good_config = Path::Class::File->new( "t/assets/good-config" );
my $bad_config = Path::Class::File->new( "t/assets/bad-config" );
my $good_sha1 = sha1_file $good_config;
my $bad_sha1 = sha1_file $bad_config;
my ($file, $backup, %options);
%options = ( silent => 1, always_yes => 1 );
sub scratch($;$) {
my $bad_file = shift;
my $good_file = shift;
my $scratch = Directory::Scratch->new;
if ($good_file) { $good_file = $scratch->file( $good_file ); $good_file->parent->mkpath; $good_file->openw->print( scalar $good_config->slurp ) }
if ($bad_file) { $bad_file = $scratch->file( $bad_file ); $bad_file->parent->mkpath; $bad_file->openw->print( scalar $bad_config->slurp ) }
return $scratch;
}
{
my $scratch = scratch '.git/config';
eval {
App::GitHub::FixRepositoryName->_try_to_fix_file_or_directory( $scratch->base, %options, backup_to => '/mnt' );
};
ok( $@ );
is( sha1_file $scratch->file( '.git/config' ), $bad_sha1 ); # File should be unchanged
}
{
my $scratch = scratch '.git/config';
($file, $backup) = App::GitHub::FixRepositoryName->_try_to_fix_file_or_directory( $scratch->base, %options );
ok( $file );
ok( $backup );
like( $backup, qr{\.git/\.backup-config-20\d{2}-.*-.{6}} );
}
{
my $scratch = scratch 'a/.git/config';
($file, $backup) = App::GitHub::FixRepositoryName->_try_to_fix_file_or_directory( $scratch->dir(qw/ a /), %options );
ok( $file );
is( sha1_file $file, $good_sha1 );
ok( $backup );
is( sha1_file $backup, $bad_sha1 );
like( $backup, qr{a/\.git/\.backup-config-20\d{2}-.*-.{6}} );
}
{
my $scratch = scratch 'a/.git/config';
($file, $backup) = App::GitHub::FixRepositoryName->_try_to_fix_file_or_directory( $scratch->dir(qw/ a /), %options );
ok( $file );
is( sha1_file $file, $good_sha1 );
ok( $backup );
is( sha1_file $backup, $bad_sha1 );
like( $backup, qr{a/\.git/\.backup-config-20\d{2}-.*-.{6}} );
}
{
my $scratch = scratch undef, '.git/config';
ok( ! App::GitHub::FixRepositoryName->_try_to_fix_file_or_directory( $scratch->base, %options ) );
}
{
my $scratch = scratch '.git/config';
($file, $backup) = App::GitHub::FixRepositoryName->_try_to_fix_file_or_directory( $scratch->base, %options, backup_to => $scratch->dir( 'somewhere/over/there' ) );
ok( $file );
is( sha1_file $file, $good_sha1 );
ok( $backup );
is( sha1_file $backup, $bad_sha1 );
like( $backup, qr{somewhere/over/there/\.backup-config-20\d{2}-.*-.{6}} );
}
{
my $scratch = scratch 'config';
$scratch->touch( $_ ) for qw/branches hooks info objects refs/;
($file, $backup) = App::GitHub::FixRepositoryName->_try_to_fix_file_or_directory( $scratch->base, %options );
ok( $file );
is( sha1_file $file, $good_sha1 );
ok( $backup );
is( sha1_file $backup, $bad_sha1 );
like( $backup, qr{\.backup-config-20\d{2}-.*-.{6}} );
}
{
my $scratch = scratch 'config';
eval {
App::GitHub::FixRepositoryName->_try_to_fix_file_or_directory( $scratch->base, %options );
};
like( $@, qr/Don't know how to fix directory/ );
}
{
my $scratch = scratch '.git/config';
($file, $backup) = App::GitHub::FixRepositoryName->_try_to_fix_file_or_directory( $scratch->base->file( '.git/config' ), %options );
ok( $file );
ok( $backup );
like( $backup, qr{\.git/\.backup-config-20\d{2}-.*-.{6}} );
}
( run in 1.321 second using v1.01-cache-2.11-cpan-49f99fa48dc )