File Coverage

lib/Git/Background.pm
Criterion Covered Total %
statement 119 119 100.0
branch 54 56 96.4
condition 21 26 80.7
subroutine 12 12 100.0
pod 3 3 100.0
total 209 216 96.7


line stmt bran cond sub pod time code
1             # vim: ts=4 sts=4 sw=4 et: syntax=perl
2             #
3             # Copyright (c) 2021-2023 Sven Kirmess
4             #
5             # Permission to use, copy, modify, and distribute this software for any
6             # purpose with or without fee is hereby granted, provided that the above
7             # copyright notice and this permission notice appear in all copies.
8             #
9             # THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
10             # WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
11             # MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
12             # ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
13             # WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
14             # ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
15             # OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
16              
17 13     13   1125808 use 5.010;
  13         155  
18 13     13   82 use strict;
  13         26  
  13         273  
19 13     13   62 use warnings;
  13         43  
  13         659  
20              
21             package Git::Background;
22              
23             our $VERSION = '0.007_02';
24              
25 13     13   77 use Carp ();
  13         24  
  13         423  
26 13     13   11875 use Path::Tiny 0.125 ();
  13         188395  
  13         436  
27 13     13   7552 use Proc::Background 1.30;
  13         86821  
  13         662  
28 13     13   96 use Scalar::Util ();
  13         28  
  13         238  
29              
30 13     13   5979 use Git::Background::Future;
  13         38  
  13         14366  
31              
32             # Git::Background->new;
33             # Git::Background->new($dir);
34             # Git::Background->new( { %options } );
35             # Git::Background->new( $dir, { %options } );
36             # options:
37             # - dir
38             # - fatal (default 1)
39             sub new {
40 26     26 1 37607 my $class = shift;
41              
42             NEW: {
43 26         55 my $self;
  26         44  
44              
45 26 100       96 last NEW if @_ > 2;
46              
47 25         43 my $dir;
48              
49 25 100 100     258 if (
      100        
50             @_
51             && (
52             # first argument is a scalar
53             !defined Scalar::Util::reftype( $_[0] )
54              
55             # or object
56             || defined Scalar::Util::blessed( $_[0] )
57             )
58             )
59             {
60 7         24 my $arg = shift @_;
61              
62             # stringify objects (e.g. Path::Tiny)
63 7         60 $dir = "$arg";
64             }
65              
66 25 100       91 last NEW if @_ > 1;
67              
68 24 100       71 if (@_) {
69 21 100 66     176 last NEW if !defined Scalar::Util::reftype( $_[0] ) || Scalar::Util::reftype( $_[0] ) ne 'HASH';
70              
71             # first/remaining argument is a hash ref
72 20         63 my $args = shift @_;
73 20         72 $self = $class->_process_args($args);
74             }
75             else {
76 3         8 $self = $class->_process_args;
77             }
78              
79 21 100       66 if ( defined $dir ) {
80 6 100       142 Carp::croak 'Cannot specify dir as positional argument and in argument hash' if exists $self->{_dir};
81 5         37 $self->{_dir} = $dir;
82             }
83              
84 20         48 bless $self, $class;
85 20         103 return $self;
86             }
87              
88             # unknown args
89 3         286 Carp::croak 'usage: new( [DIR], [ARGS] )';
90             }
91              
92             # Git::Background->run( @cmd );
93             # Git::Background->run( @cmd, { %options } );
94             sub run {
95 32     32 1 56393 my ( $self, @cmd ) = @_;
96              
97 32 100       387 Carp::croak 'Cannot use run() in void context. (The git process would immediately get killed.)' if !defined wantarray; ## no critic (Community::Wantarray)
98              
99 31         64 my $config;
100 31 100 100     474 if ( @cmd && defined Scalar::Util::reftype( $cmd[-1] ) && Scalar::Util::reftype( $cmd[-1] ) eq 'HASH' ) {
      66        
101 17         55 my $args = pop @cmd;
102 17         93 $config = $self->_process_args($args);
103             }
104             else {
105 14         93 $config = $self->_process_args;
106             }
107              
108 31         248 my $stdout;
109             my $stdout_fh;
110 31         0 my $stderr;
111 31         0 my $stderr_fh;
112 31         0 my $e;
113 31         0 my $ok;
114             {
115 31         57 local $@; ## no critic (Variables::RequireInitializationForLocalVars)
  31         56  
116 31         63 $ok = eval {
117 31         64 $e = 'Cannot create temporary file for stdout';
118 31         255 $stdout = Path::Tiny->tempfile;
119 30         205284 $e = 'Cannot obtain file handle for stdout temp file';
120 30         139 $stdout_fh = $stdout->filehandle('>');
121 29         3840 $e = 'Cannot create temporary file for stdout';
122 29         191 $stderr = Path::Tiny->tempfile;
123 28         14614 $e = 'Cannot obtain file handle for stderr temp file';
124 28         101 $stderr_fh = $stderr->filehandle('>');
125 27         3106 1;
126             };
127              
128 31 100       682 if ( !$ok ) {
129 4 50 33     23 if ( defined $@ && $@ ne q{} ) {
130 4         22 $e .= ": $@";
131             }
132             }
133             }
134 31 100       437 Carp::croak $e if !$ok;
135              
136             # Proc::Background
137             my $proc_args = {
138             stdin => undef,
139             stdout => $stdout_fh,
140             stderr => $stderr_fh,
141 27         315 command => [ @{ $config->{_git} }, @cmd ],
142             autodie => 1,
143             autoterminate => 1,
144 27 100       98 ( defined $config->{_dir} ? ( cwd => $config->{_dir} ) : () ),
145             };
146              
147 27         64 my $proc;
148             {
149 27         49 local @_; ## no critic (Variables::RequireInitializationForLocalVars)
  27         65  
150 27         101 local $Carp::Internal{ (__PACKAGE__) } = 1;
151              
152 27         58 $proc = eval { Proc::Background->new($proc_args); };
  27         293  
153              
154 27 100       90553 if ( !defined $proc ) {
155              
156             # The Future->fail exception must be true
157 3   100     39 $e = qq{$@} || 'Failed to run Git with Proc::Background';
158             }
159             }
160 27 100       227 return Git::Background::Future->fail( $e, 'Proc::Background' ) if !defined $proc;
161              
162             return Git::Background::Future->new(
163             {
164             _fatal => $config->{_fatal},
165 24         1244 _proc => $proc,
166             _stdout => $stdout,
167             _stderr => $stderr,
168             },
169             );
170             }
171              
172             sub version {
173 6     6 1 14636 my ( $self, $args ) = @_;
174              
175 6         26 my @cmd = qw(--version);
176 6 100       125 if ( defined $args ) {
177 5 100 100     453 Carp::croak 'usage: Git::Background->version([ARGS])' if !defined Scalar::Util::reftype($args) || Scalar::Util::reftype($args) ne 'HASH';
178              
179 3         12 push @cmd, $args;
180             }
181              
182 4         10 my $version = eval {
183 4         12 for my $line ( $self->run(@cmd)->stdout ) {
184 3 50       344 if ( $line =~ s{ \A git \s version \s }{}xsm ) {
185 3         43 return $line;
186             }
187             }
188              
189 1         101 return;
190             };
191              
192 4         596 return $version;
193             }
194              
195             sub _process_args {
196 54     54   163 my ( $self, $args ) = @_;
197              
198 54 100       249 if ( !defined Scalar::Util::blessed($self) ) {
199 26         73 $self = {};
200             }
201              
202 54         120 my %args_keys = map { $_ => 1 } keys %{$args};
  40         190  
  54         207  
203 54         321 my %config = (
204             _fatal => !!1,
205             _git => ['git'],
206             );
207              
208             # dir
209 54 100       257 if ( exists $args->{dir} ) {
    100          
210              
211             # stringify objects (e.g. Path::Tiny)
212 1         6 $config{_dir} = "$args->{dir}";
213 1         3 delete $args_keys{dir};
214             }
215             elsif ( exists $self->{_dir} ) {
216 5         23 $config{_dir} = $self->{_dir};
217             }
218              
219             # fatal
220 54 100       184 if ( exists $args->{fatal} ) {
    100          
221 14         61 $config{_fatal} = !!$args->{fatal};
222 14         35 delete $args_keys{fatal};
223             }
224             elsif ( exists $self->{_fatal} ) {
225 16         51 $config{_fatal} = $self->{_fatal};
226             }
227              
228             # git
229 54 100       159 if ( exists $args->{git} ) {
    100          
230 22         46 my $git = $args->{git};
231             $config{_git} = [
232             ( defined Scalar::Util::reftype($git) && Scalar::Util::reftype($git) eq 'ARRAY' )
233 22 100 66     259 ? @{ $args->{git} }
  20         90  
234             : $git,
235             ];
236 22         58 delete $args_keys{git};
237             }
238             elsif ( exists $self->{_git} ) {
239 26         54 $config{_git} = [ @{ $self->{_git} } ];
  26         127  
240             }
241              
242             #
243 54         184 my @unknown = sort keys %args_keys;
244 54 100       459 Carp::croak 'Unknown argument' . ( @unknown > 1 ? 's' : q{} ) . q{: '} . join( q{', '}, sort @unknown ) . q{'} if @unknown;
    100          
245              
246 52         208 return \%config;
247             }
248              
249             1;
250              
251             __END__