diff options
author | Sean Whitton <spwhitton@spwhitton.name> | 2020-02-07 23:43:50 -0700 |
---|---|---|
committer | Sean Whitton <spwhitton@spwhitton.name> | 2020-02-07 23:43:50 -0700 |
commit | 4ee46956d3ed75bb3516a0e07a1235ef3c6c09ef (patch) | |
tree | b82aca1fc27fe78dd0dfbef5defa697f01299c36 /bin | |
parent | 2ed222c8ea789702b2aeffd63e177abd08f21b80 (diff) | |
download | p5-Git-Annex-4ee46956d3ed75bb3516a0e07a1235ef3c6c09ef.tar.gz |
convert remaining two scripts to App:: modules
Signed-off-by: Sean Whitton <spwhitton@spwhitton.name>
Diffstat (limited to 'bin')
-rwxr-xr-x | bin/annex-to-annex-dropunused | 41 | ||||
-rwxr-xr-x | bin/annex-to-annex-reinject | 101 |
2 files changed, 4 insertions, 138 deletions
diff --git a/bin/annex-to-annex-dropunused b/bin/annex-to-annex-dropunused index 9abb25f..bbbea80 100755 --- a/bin/annex-to-annex-dropunused +++ b/bin/annex-to-annex-dropunused @@ -40,42 +40,5 @@ git-annex-dropunused(1), annex-to-annex(1), annex-to-annex-reinject(1) =cut -use 5.028; -use strict; -use warnings; - -use autodie; -use Git::Annex; - -# This script used to have a --dest option which specified the -# destination annex previously used with annex-to-annex. Then, if the -# unused file had a hardlink count of 1, but was present in the -# destination annex, this script would drop it. -# -# That was somewhat dangerous functionality because it involves this -# script running `git annex dropunused --force` for files with a -# hardlink count of 1. And further, it is not actually needed, -# because running annex-to-annex-reinject after -# annex-to-annex-dropunused handles such files in a way that is safer. -# -# It is still good to run this script before annex-to-annex-reinject -# to make the latter faster. - -my $annex = Git::Annex->new; - -my @to_drop; -my @unused_files = grep { !$_->{bad} && !$_->{tmp} } @{ $annex->unused }; - -foreach my $unused_file (@unused_files) { - my $content = $annex->abs_contentlocation($unused_file->{key}); - my $link_count = (stat $content)[3]; - my @logs - = $annex->git->log({ no_textconv => 1 }, "-S", $unused_file->{key}); - - next unless $logs[0] and $logs[0]->message =~ /migrated by annex-to-annex/; - next unless $link_count > 1; - - push @to_drop, $unused_file->{number}; -} - -$annex->git->annex("dropunused", { force => 1 }, @to_drop); +use App::annex_to_annex_dropunused; +exit App::annex_to_annex->main; diff --git a/bin/annex-to-annex-reinject b/bin/annex-to-annex-reinject index 897c007..b3f5970 100755 --- a/bin/annex-to-annex-reinject +++ b/bin/annex-to-annex-reinject @@ -50,102 +50,5 @@ git-annex-reinject(1), annex-to-annex(1), annex-to-annex-dropunused(1) =cut -use 5.028; -use strict; -use warnings; - -use autodie; -use Git::Annex; -use File::Basename qw(basename dirname); -use File::chmod; -$File::chmod::UMASK = 0; -use File::Path qw(rmtree); -use File::Spec::Functions qw(rel2abs); -use File::Find; -use Try::Tiny; - -die "usage: annex-to-annex-reinject SOURCEANNEX DESTANNEX\n" unless @ARGV == 2; - -my $source = Git::Annex->new($ARGV[0]); -my $dest = Git::Annex->new($ARGV[1]); -#<<< -try { - $source->git->rev_parse({ git_dir => 1 }); -} catch { - die "$ARGV[0] doesn't look like a git repository ..\n"; -}; -try { - $dest->git->rev_parse({ git_dir => 1 }); -} catch { - die "$ARGV[1] doesn't look like a git repository ..\n"; -}; -#>>> - -# `git annex reinject` doesn't work in a bare repo atm -my $use_worktree - = ($dest->git->rev_parse({ is_bare_repository => 1 }))[0] eq 'true'; -my ($temp, $worktree); -if ($use_worktree) { - $temp = tempdir(CLEANUP => 1, DIR => dirname $ARGV[1]); - say "bare repo; our git worktree is in $temp"; - $dest->git->worktree("add", { force => 1, detach => 1 }, - rel2abs($temp), "synced/master"); -} - -my ($source_uuid) = $source->git->config('annex.uuid'); -die "couldn't get source annex uuid" unless $source_uuid =~ /\A[a-z0-9-]+\z/; -my $spk = $source->batch("setpresentkey"); - -my ($source_objects_dir) - = $source->git->rev_parse({ git_path => 1 }, "annex/objects"); -$source_objects_dir = rel2abs $source_objects_dir, $ARGV[0]; -my $reinject_from = $use_worktree ? $temp : $ARGV[1]; -say "reinjecting from $source_objects_dir into $reinject_from"; -find({ - wanted => sub { - -f or return; - say "\nconsidering $_"; - my $dir = dirname $_; - chmod "u+w", $dir, $_; - system "git", "-C", $reinject_from, "annex", "reinject", - "--known", $_; - if (-e $_) { - chmod "u-w", $dir, $_; - } else { - my $key = basename $_; - say "telling setpresentkey process '$key $source_uuid 0'"; - say for $spk->say("$key $source_uuid 0"); - # alt. to setpresentkey: - # say "fscking key $key in $ARGV[0]"; - # system 'git', '-C', $ARGV[0], 'annex', 'fsck', - # '--numcopies=1', '--key', $key; - say "cleaning up empty dirs"; - foreach my $d ($dir, dirname($dir), dirname(dirname($dir))) { - last unless is_empty_dir($d); - rmdir $d; - } - } - }, - no_chdir => 1 - }, - $source_objects_dir -); -if ($use_worktree) { - # we can't use `git worktree remove` because the way git-annex - # worktree support works breaks that command: git-annex replaces - # the .git worktree file with a symlink - rmtree $temp; - $dest->git->worktree("prune"); -} - -# cause setpresentkey changes to be recorded in git-annex branch -undef $spk; -sleep 1; -$source->git->annex("merge"); - -sub is_empty_dir { - -d $_[0] or return 0; - opendir(my $dirh, $_[0]); - my @files = grep { $_ ne '.' && $_ ne '..' } readdir $dirh; - return @files == 0; -} +use App::annex_to_annex_reinject; +exit App::annex_to_annex_reinject->main; |