summaryrefslogtreecommitdiff
path: root/bin
diff options
context:
space:
mode:
authorSean Whitton <spwhitton@spwhitton.name>2020-02-07 23:43:50 -0700
committerSean Whitton <spwhitton@spwhitton.name>2020-02-07 23:43:50 -0700
commit4ee46956d3ed75bb3516a0e07a1235ef3c6c09ef (patch)
treeb82aca1fc27fe78dd0dfbef5defa697f01299c36 /bin
parent2ed222c8ea789702b2aeffd63e177abd08f21b80 (diff)
downloadp5-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-xbin/annex-to-annex-dropunused41
-rwxr-xr-xbin/annex-to-annex-reinject101
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;