File Coverage

blib/lib/Proc/InvokeEditor.pm
Criterion Covered Total %
statement 82 148 55.4
branch 17 54 31.4
condition 3 12 25.0
subroutine 14 17 82.3
pod 8 8 100.0
total 124 239 51.8


line stmt bran cond sub pod time code
1             package Proc::InvokeEditor;
2              
3 2     2   87247 use strict;
  2         6  
  2         52  
4 2     2   9 use warnings;
  2         4  
  2         60  
5              
6 2     2   929 use File::Temp qw(tempfile);
  2         39057  
  2         249  
7 2     2   21 use File::Spec;
  2         7  
  2         59  
8 2     2   1212 use IPC::Cmd qw(can_run);
  2         113517  
  2         173  
9 2     2   1051 use Carp::Assert;
  2         2700  
  2         14  
10 2     2   299 use Fcntl;
  2         6  
  2         599  
11             File::Temp->safe_level( File::Temp::HIGH );
12              
13             require Exporter;
14              
15 2         3164 use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK @EXPORT $VERSION
16 2     2   18 @DEFAULT_EDITORS);
  2         5  
17              
18             @ISA = qw(Exporter);
19              
20             # Items to export into callers namespace by default. Note: do not export
21             # names by default without a very good reason. Use EXPORT_OK instead.
22             # Do not simply export all your public functions/methods/constants.
23              
24             # This allows declaration use Proc::InvokeEditor ':all';
25             # If you do not need this, moving things directly into @EXPORT or @EXPORT_OK
26             # will save memory.
27             %EXPORT_TAGS = ( 'all' => [ qw(
28            
29             ) ] );
30              
31             @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
32              
33             @EXPORT = qw(
34            
35             );
36             $VERSION = '1.11';
37              
38             @DEFAULT_EDITORS = ( $ENV{'VISUAL'}, $ENV{'EDITOR'}, '/usr/bin/vi',
39             '/bin/vi', '/bin/ed',
40             map({ can_run($_) } qw(vi ed notepad.exe))
41             );
42              
43             sub new {
44 1     1 1 78 my $proto = shift;
45 1   33     8 my $class = ref($proto) || $proto;
46 1         7 my $self = {
47             'editors' => \@DEFAULT_EDITORS,
48             'cleanup' => 1,
49             'keep_file' => 0,
50             };
51 1 50       4 croak("$class requires an even number of parameters") if @_ % 2;
52 1         4 my %args = @_;
53 1         3 foreach my $param (qw(editors cleanup keep_file)) {
54 3 50       8 if ($args{$param}) {
55 0         0 $self->{$param} = $args{$param};
56             }
57             }
58 1         2 bless ($self, $class);
59 1         3 return $self;
60             }
61              
62             sub editors {
63 4     4 1 1376 my $self = shift;
64 4         5 my $editors = shift;
65 4 100       10 if (defined $editors) {
66 1         8 assert(ref($editors) eq 'ARRAY');
67 1         10 $self->{'editors'} = $editors;
68             }
69 4         9 return $self->{'editors'};
70             }
71              
72             sub editors_prepend {
73 1     1 1 503 my $self = shift;
74 1         2 my $edit = shift;
75 1         5 assert(ref($edit) eq 'ARRAY');
76 1         4 my @editors = @{$self->{'editors'}};
  1         3  
77 1         4 unshift @editors, @$edit;
78 1         3 $self->{'editors'} = \@editors;
79             }
80              
81             sub editors_env {
82 1     1 1 405 my $self = shift;
83 1         7 my $edit = shift;
84 1         5 assert(ref($edit) eq 'ARRAY');
85 1         3 my @editors;
86 1 50       4 if (@$edit) {
87 1         3 foreach my $e (@$edit) {
88 2 50 33     9 if (exists $ENV{$e} and defined $ENV{$e}) {
89 2         5 push @editors, $ENV{$e};
90             }
91             }
92 1         2 my @editors_list = @{$self->{'editors'}};
  1         3  
93 1         4 unshift @editors_list, @editors;
94 1         2 $self->{'editors'} = \@editors_list;
95             }
96 1         3 return $self->{'editors'};
97             }
98              
99             sub cleanup {
100 2     2 1 731 my $self = shift;
101 2         4 my $cleanup = shift;
102 2 100       8 $self->{'cleanup'} = $cleanup if defined $cleanup;
103 2         5 return $self->{'cleanup'};
104             }
105              
106             sub keep_file {
107 0     0 1 0 my $self = shift;
108 0         0 my $keep_file = shift;
109 0 0       0 $self->{'keep_file'} = $keep_file if defined $keep_file;
110 0         0 return $self->{'keep_file'};
111             }
112              
113             sub edit {
114 0     0 1 0 my $self = shift;
115 0         0 my $arg = shift;
116 0         0 my $suff = shift;
117             # if the argument supplied is a reference to an array of lines,
118             # join it together based on the input record separator
119 0 0       0 if (ref($arg) eq 'ARRAY') {
120 0         0 $arg = join $/, @$arg;
121             }
122 0         0 my $result;
123 0 0       0 if (ref($self)) {
124             ($result, $self->{'filename'}) = _edit(
125             $arg,
126             $self->{'editors'},
127             $self->{'cleanup'},
128             $self->{'keep_file'},
129 0         0 $self->{'filename'},
130             $suff,
131             );
132             } else {
133 0         0 ($result) = _edit($arg, \@DEFAULT_EDITORS, 1, 0, undef, $suff);
134             }
135 0 0       0 if (wantarray) {
136 0         0 my @result = split m|$/|, $result;
137 0         0 return @result;
138             } else {
139 0         0 return $result;
140             }
141             }
142              
143             sub first_usable {
144 1     1 1 440 my $self = shift;
145 1         2 my $er = shift;
146 1         2 my @editors;
147 1 50       3 if (defined $er) {
148 0         0 @editors = @$er;
149             } else {
150 1 50       3 if (ref $self) {
151 0         0 @editors = @{$self->{'editors'}};
  0         0  
152             } else {
153 1         4 @editors = @DEFAULT_EDITORS;
154             }
155             }
156              
157 1         2 my $chosen_editor;
158 1         27 my @path = File::Spec->path;
159 1         3 EDITORS: foreach my $editor (@editors) {
160 8 100       17 next unless defined $editor;
161 3         4 my @editor_bits;
162 3 50       10 if( $^O =~ /mswin/i ) {
163 0         0 require Text::ParseWords;
164 0         0 $editor =~ s!\\!\\\\!g; # quote path for shellwords
165 0         0 @editor_bits = Text::ParseWords::shellwords($editor);
166             } else {
167 3         9 @editor_bits = split /\s+/, $editor;
168             };
169 3 50       14 next unless defined $editor_bits[0];
170 3 50 33     38 if (File::Spec->file_name_is_absolute($editor_bits[0])
171             and -x $editor_bits[0]) {
172 0         0 $chosen_editor = \@editor_bits;
173 0         0 last;
174             } else {
175 3         5 foreach my $dir (@path) {
176 27         128 my $file = File::Spec->catfile($dir, $editor_bits[0]);
177 27 50       179 if (-x $file) {
178 0         0 $editor_bits[0] = $file;
179 0         0 $chosen_editor = \@editor_bits;
180 0         0 last EDITORS;
181             }
182             }
183             }
184             }
185 1 50       96 die "Couldn't find an editor: $!" unless defined $chosen_editor;
186              
187 0           return $chosen_editor;
188             }
189              
190             sub _edit {
191 0     0     my $string = shift;
192 0           my $er = shift;
193 0           my $unlink = shift;
194 0           my $keep_file = shift;
195 0           my $filename = shift;
196 0           my $suff = shift;
197              
198 0           assert(ref($er) eq 'ARRAY');
199 0           assert(defined $unlink);
200 0           my @editors = @$er;
201             # Find an editor
202              
203 0           my $chosen_editor = first_usable(undef, $er);
204              
205 0           my @suff;
206 0 0         @suff = (SUFFIX => $suff) if $suff;
207              
208             # get a temp file, and write the text to it
209 0 0 0       if (defined($filename) && $keep_file) {
210 0 0         open my $fh, '>', $filename or die "Couldn't open tempfile [$filename]; $!";
211 0           print $fh $string;
212 0 0         close $fh or die "Couldn't close tempfile [$filename]; $!";
213             }
214             else {
215 0           my $fh;
216 0           ($fh, $filename) = tempfile(UNLINK => $unlink, @suff);
217 0           print $fh $string;
218 0 0         close $fh or die "Couldn't close tempfile [$filename]; $!";
219             }
220             # start the editor
221 0           my $rc = system @$chosen_editor, $filename;
222             # check what happened - die if it all went wrong.
223 0 0         unless ($rc == 0) {
224 0           my ($exit_value, $signal_num, $dumped_core);
225 0           $exit_value = $? >> 8;
226 0           $signal_num = $? & 127;
227 0           $dumped_core = $? & 128;
228 0           die "Error in editor - exit val = $exit_value, signal = $signal_num, coredump? = $dumped_core: $!";
229             }
230              
231             # read the temp file
232 0 0         sysopen(FH, $filename, O_RDONLY) or die "Couldn't sysopen $filename: $!";
233 0           my $result;
234 0           { local $/; $result = ; }
  0            
  0            
235 0 0         close FH or die "Couldn't close [$filename]: $!";
236             # return as string
237 0 0         if ($keep_file) {
238 0           return ($result, $filename);
239             }
240             else {
241 0           return ($result);
242             }
243             }
244              
245             1;
246             __END__