From 4ee46956d3ed75bb3516a0e07a1235ef3c6c09ef Mon Sep 17 00:00:00 2001 From: Sean Whitton Date: Fri, 7 Feb 2020 23:43:50 -0700 Subject: convert remaining two scripts to App:: modules Signed-off-by: Sean Whitton --- bin/annex-to-annex-dropunused | 41 +---------- bin/annex-to-annex-reinject | 101 +------------------------- lib/App/annex_to_annex_dropunused.pm | 74 +++++++++++++++++++ lib/App/annex_to_annex_reinject.pm | 136 +++++++++++++++++++++++++++++++++++ t/22_annex-to-annex-dropunused.t | 24 +++---- t/23_annex-to-annex-reinject.t | 15 ++-- 6 files changed, 228 insertions(+), 163 deletions(-) create mode 100644 lib/App/annex_to_annex_dropunused.pm create mode 100644 lib/App/annex_to_annex_reinject.pm 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; diff --git a/lib/App/annex_to_annex_dropunused.pm b/lib/App/annex_to_annex_dropunused.pm new file mode 100644 index 0000000..89b16b5 --- /dev/null +++ b/lib/App/annex_to_annex_dropunused.pm @@ -0,0 +1,74 @@ +package App::annex_to_annex_dropunused; +# ABSTRACT: drop old hardlinks migrated by annex-to-annex +# +# Copyright (C) 2019-2020 Sean Whitton +# +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or (at +# your option) any later version. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +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. + +exit main() unless caller; + +=func main + +Implementation of annex-to-annex-dropunused(1). Please see +documentation for that command. + +=cut + +sub main { + 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); + + return 0; +} + +1; diff --git a/lib/App/annex_to_annex_reinject.pm b/lib/App/annex_to_annex_reinject.pm new file mode 100644 index 0000000..c208d05 --- /dev/null +++ b/lib/App/annex_to_annex_reinject.pm @@ -0,0 +1,136 @@ +package App::annex_to_annex_reinject; +# ABSTRACT: annex-to-annex-reinject +# +# Copyright (C) 2019-2020 Sean Whitton +# +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation, either version 3 of the License, or (at +# your option) any later version. +# +# This program is distributed in the hope that it will be useful, but +# WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +# General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +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; + +exit main() unless caller; + +=func main + +Implementation of annex-to-annex-reinject(1). Please see +documentation for that command. + +=cut + +sub main { + 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"); + + return 0; +} + + +sub _is_empty_dir { + -d $_[0] or return 0; + opendir(my $dirh, $_[0]); + my @files = grep { $_ ne '.' && $_ ne '..' } readdir $dirh; + return @files == 0; +} + +1; diff --git a/t/22_annex-to-annex-dropunused.t b/t/22_annex-to-annex-dropunused.t index c8bd47a..41db816 100755 --- a/t/22_annex-to-annex-dropunused.t +++ b/t/22_annex-to-annex-dropunused.t @@ -5,6 +5,8 @@ use strict; use warnings; use lib 't/lib'; +use App::annex_to_annex; +use App::annex_to_annex_dropunused; use Test::More; use File::Spec::Functions qw(rel2abs); use t::Setup; @@ -15,22 +17,14 @@ use File::Copy qw(copy); plan skip_all => "device ID issues" if device_id_issues; -# make sure that `make test` will always use the right version of the -# script we seek to test -my $a2a = "annex-to-annex"; -my $a2a_du = "annex-to-annex-dropunused"; -$a2a = rel2abs "blib/script/annex-to-annex" if -x "blib/script/annex-to-annex"; -$a2a_du = rel2abs "blib/script/annex-to-annex-dropunused" - if -x "blib/script/annex-to-annex-dropunused"; - with_temp_annexes { my (undef, undef, $source2) = @_; - system $a2a, qw(--commit source1/foo source2/other dest); + run_bin qw(annex-to-annex --commit source1/foo source2/other dest); { local $CWD = "source2"; - system $a2a_du; + run_bin "annex-to-annex-dropunused"; $source2->checkout("master~1"); ok((lstat "other" and not stat "other"), "other was dropped"); } @@ -39,7 +33,7 @@ with_temp_annexes { with_temp_annexes { my (undef, undef, $source2) = @_; - system $a2a, qw(--commit source1/foo source2/other dest); + run_bin qw(annex-to-annex --commit source1/foo source2/other dest); { local $CWD = "source2"; @@ -55,11 +49,11 @@ with_temp_annexes { system "mv", "-f", "$other_content.tmp", $other_content; chmod 0555, dirname $other_content; - system $a2a_du; + run_bin "annex-to-annex-dropunused"; $source2->checkout("master~1"); ok((lstat "other" and stat "other"), "other was not dropped"); # $source2->checkout("master"); - # system $a2a_du, "--dest=../dest"; + # run_bin qw(annex-to-annex-dropunused --dest=../dest); # $source2->checkout("master~1"); # ok((lstat "other" and not stat "other"), "other was dropped"); } @@ -68,7 +62,7 @@ with_temp_annexes { # with_temp_annexes { # my (undef, undef, $source2, $dest) = @_; -# system $a2a, qw(--commit source1/foo source2/other dest); +# run_bin qw(annex-to-annex --commit source1/foo source2/other dest); # $dest->annex(qw(drop --force other)); # { @@ -85,7 +79,7 @@ with_temp_annexes { # system "mv", "-f", "$other_content.tmp", $other_content; # chmod 0555, dirname $other_content; -# system $a2a_du, "--dest=../dest"; +# run_bin qw(annex-to-annex-dropunused --dest=../dest); # $source2->checkout("master~1"); # ok((lstat "other" and stat "other"), "other was not dropped"); # } diff --git a/t/23_annex-to-annex-reinject.t b/t/23_annex-to-annex-reinject.t index 2e672ea..5791c81 100755 --- a/t/23_annex-to-annex-reinject.t +++ b/t/23_annex-to-annex-reinject.t @@ -5,23 +5,18 @@ use strict; use warnings; use lib 't/lib'; +use App::annex_to_annex; +use App::annex_to_annex_reinject; use Test::More; use File::Spec::Functions qw(rel2abs); use t::Setup; +use t::Util; use File::chdir; -# make sure that `make test` will always use the right version of the -# script we seek to test -my $a2a = "annex-to-annex"; -my $a2a_ri = "annex-to-annex-reinject"; -$a2a = rel2abs "blib/script/annex-to-annex" if -x "blib/script/annex-to-annex"; -$a2a_ri = rel2abs "blib/script/annex-to-annex-reinject" - if -x "blib/script/annex-to-annex-reinject"; - with_temp_annexes { my (undef, undef, $source2) = @_; - system $a2a, qw(--commit source1/foo source2/other dest); + run_bin qw(annex-to-annex --commit source1/foo source2/other dest); { local $CWD = "source2"; $source2->checkout("master~1"); @@ -29,7 +24,7 @@ with_temp_annexes { "other is initially present"; $source2->checkout("master"); } - system $a2a_ri, qw(source2 dest); + run_bin qw(annex-to-annex-reinject source2 dest); { local $CWD = "source2"; $source2->checkout("master~1"); -- cgit v1.2.3