1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
|
package Git::Annex::BatchCommand;
# ABSTRACT: Perl interface to git-annex --batch commands
#
# Copyright (C) 2020 Sean Whitton <spwhitton@spwhitton.name>
#
# 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 <http://www.gnu.org/licenses/>.
=head1 SYNOPSIS
# you should not instantiate this class yourself; use Git::Annex::batch
my $annex = Git::Annex->new("/home/spwhitton/annex");
my $batch = $annex->batch("find", "--not", "--in=here");
# see git-annex-find(1) -- `git annex find --batch --not --in here`
# prints an empty string for each file which is not present
say "foo/bar is not present in this repo" if $batch->say("foo/bar");
=head1 DESCRIPTION
This class can be used to run git-annex commands which take the
C<--batch> option. You can feed the command lines of input and you
will get back git-annex's responses.
The main point of using C<--batch> commands from Perl is to keep
git-annex running rather than repeatedly executing new git-annex
processes to perform queries or request changes.
=cut
use 5.028;
use strict;
use warnings;
use autodie;
use Carp;
use IPC::Open2;
=method new($annex, $cmd, @args)
Initialise a batch process in Git::Annex C<$annex>, running git-annex
subcommand C<$cmd> (e.g. C<setpresentkey>) with arguments C<@args>.
You should use Git::Annex::batch in preference to this method.
=cut
sub new {
my (undef, $annex, $cmd, @params) = @_;
croak "not enough arguments to Git::Annex::BatchCommand constructor"
unless $annex and $cmd;
# normalise supplied arguments a little
unshift @params, "--batch" unless grep /\A--batch\z/, @params;
my $self = bless { _annex => $annex, _cmd => [$cmd, @params] }
=> "Git::Annex::BatchCommand";
$self->_spawn;
return $self;
}
=method say($input, ...)
Say a line or lines of input to the batch command's standard input.
Trailing line breaks in C<$input> are optional.
In list context, returns a list of git-annex's responses to the items
of input, chomped. In scalar context, returns the last of git-annex's
responses, chomped.
=cut
sub say {
my ($self, @input) = @_;
my @output;
for (@input) {
chomp;
say { $self->{_in} } $_;
chomp(my $out = readline $self->{_out});
push @output, $out;
}
return wantarray ? @output : $output[$#output];
}
=method ask($input, ...)
Synonym for C<say> method.
=cut
*ask = \&say;
=method restart
Kill and restart the C<--batch> command.
This is sometimes needed to ensure the C<--batch> command picks up
changes made to the git-annex branch.
=cut
sub restart {
my $self = shift;
$self->_despawn;
$self->_spawn;
}
sub _spawn {
my $self = shift;
my ($out, $in);
$self->{_pid} = open2 $out, $in, "git",
"-C", $self->{_annex}->toplevel,
"annex", @{ $self->{_cmd} };
($self->{_out}, $self->{_in}) = ($out, $in);
}
sub _despawn {
my $self = shift;
close $self->{_in};
close $self->{_out};
# reap the child per IPC::Open2 docs
waitpid $self->{_pid}, 0;
}
sub DESTROY { local($., $@, $!, $^E, $?); shift->_despawn }
1;
|
