line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Proc::InvokeEditor; |
2
|
|
|
|
|
|
|
|
3
|
2
|
|
|
2
|
|
55263
|
use strict; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
46
|
|
4
|
2
|
|
|
2
|
|
9
|
use warnings; |
|
2
|
|
|
|
|
3
|
|
|
2
|
|
|
|
|
52
|
|
5
|
|
|
|
|
|
|
|
6
|
2
|
|
|
2
|
|
897
|
use File::Temp qw(tempfile); |
|
2
|
|
|
|
|
32570
|
|
|
2
|
|
|
|
|
99
|
|
7
|
2
|
|
|
2
|
|
12
|
use File::Spec; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
37
|
|
8
|
2
|
|
|
2
|
|
814
|
use IPC::Cmd qw(can_run); |
|
2
|
|
|
|
|
80030
|
|
|
2
|
|
|
|
|
106
|
|
9
|
2
|
|
|
2
|
|
776
|
use Carp::Assert; |
|
2
|
|
|
|
|
1955
|
|
|
2
|
|
|
|
|
10
|
|
10
|
2
|
|
|
2
|
|
221
|
use Fcntl; |
|
2
|
|
|
|
|
4
|
|
|
2
|
|
|
|
|
520
|
|
11
|
|
|
|
|
|
|
File::Temp->safe_level( File::Temp::HIGH ); |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
require Exporter; |
14
|
|
|
|
|
|
|
|
15
|
2
|
|
|
|
|
2394
|
use vars qw(@ISA %EXPORT_TAGS @EXPORT_OK @EXPORT $VERSION |
16
|
2
|
|
|
2
|
|
20
|
@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.12'; |
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
|
68
|
my $proto = shift; |
45
|
1
|
|
33
|
|
|
5
|
my $class = ref($proto) || $proto; |
46
|
1
|
|
|
|
|
4
|
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
|
|
|
|
|
3
|
my %args = @_; |
53
|
1
|
|
|
|
|
2
|
foreach my $param (qw(editors cleanup keep_file)) { |
54
|
3
|
50
|
|
|
|
7
|
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
|
1075
|
my $self = shift; |
64
|
4
|
|
|
|
|
9
|
my $editors = shift; |
65
|
4
|
100
|
|
|
|
14
|
if (defined $editors) { |
66
|
1
|
|
|
|
|
8
|
assert(ref($editors) eq 'ARRAY'); |
67
|
1
|
|
|
|
|
14
|
$self->{'editors'} = $editors; |
68
|
|
|
|
|
|
|
} |
69
|
4
|
|
|
|
|
13
|
return $self->{'editors'}; |
70
|
|
|
|
|
|
|
} |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
sub editors_prepend { |
73
|
1
|
|
|
1
|
1
|
534
|
my $self = shift; |
74
|
1
|
|
|
|
|
3
|
my $edit = shift; |
75
|
1
|
|
|
|
|
6
|
assert(ref($edit) eq 'ARRAY'); |
76
|
1
|
|
|
|
|
6
|
my @editors = @{$self->{'editors'}}; |
|
1
|
|
|
|
|
5
|
|
77
|
1
|
|
|
|
|
5
|
unshift @editors, @$edit; |
78
|
1
|
|
|
|
|
5
|
$self->{'editors'} = \@editors; |
79
|
|
|
|
|
|
|
} |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub editors_env { |
82
|
1
|
|
|
1
|
1
|
457
|
my $self = shift; |
83
|
1
|
|
|
|
|
8
|
my $edit = shift; |
84
|
1
|
|
|
|
|
7
|
assert(ref($edit) eq 'ARRAY'); |
85
|
1
|
|
|
|
|
6
|
my @editors; |
86
|
1
|
50
|
|
|
|
6
|
if (@$edit) { |
87
|
1
|
|
|
|
|
4
|
foreach my $e (@$edit) { |
88
|
2
|
50
|
33
|
|
|
14
|
if (exists $ENV{$e} and defined $ENV{$e}) { |
89
|
2
|
|
|
|
|
8
|
push @editors, $ENV{$e}; |
90
|
|
|
|
|
|
|
} |
91
|
|
|
|
|
|
|
} |
92
|
1
|
|
|
|
|
3
|
my @editors_list = @{$self->{'editors'}}; |
|
1
|
|
|
|
|
5
|
|
93
|
1
|
|
|
|
|
5
|
unshift @editors_list, @editors; |
94
|
1
|
|
|
|
|
3
|
$self->{'editors'} = \@editors_list; |
95
|
|
|
|
|
|
|
} |
96
|
1
|
|
|
|
|
5
|
return $self->{'editors'}; |
97
|
|
|
|
|
|
|
} |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
sub cleanup { |
100
|
2
|
|
|
2
|
1
|
492
|
my $self = shift; |
101
|
2
|
|
|
|
|
6
|
my $cleanup = shift; |
102
|
2
|
100
|
|
|
|
10
|
$self->{'cleanup'} = $cleanup if defined $cleanup; |
103
|
2
|
|
|
|
|
6
|
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
|
442
|
my $self = shift; |
145
|
1
|
|
|
|
|
3
|
my $er = shift; |
146
|
1
|
|
|
|
|
3
|
my @editors; |
147
|
1
|
50
|
|
|
|
5
|
if (defined $er) { |
148
|
0
|
|
|
|
|
0
|
@editors = @$er; |
149
|
|
|
|
|
|
|
} else { |
150
|
1
|
50
|
|
|
|
4
|
if (ref $self) { |
151
|
0
|
|
|
|
|
0
|
@editors = @{$self->{'editors'}}; |
|
0
|
|
|
|
|
0
|
|
152
|
|
|
|
|
|
|
} else { |
153
|
1
|
|
|
|
|
6
|
@editors = @DEFAULT_EDITORS; |
154
|
|
|
|
|
|
|
} |
155
|
|
|
|
|
|
|
} |
156
|
|
|
|
|
|
|
|
157
|
1
|
|
|
|
|
3
|
my $chosen_editor; |
158
|
1
|
|
|
|
|
25
|
my @path = File::Spec->path; |
159
|
1
|
|
|
|
|
5
|
EDITORS: foreach my $editor (@editors) { |
160
|
8
|
100
|
|
|
|
20
|
next unless defined $editor; |
161
|
3
|
|
|
|
|
6
|
my @editor_bits; |
162
|
3
|
50
|
|
|
|
12
|
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
|
|
|
|
|
10
|
@editor_bits = split /\s+/, $editor; |
168
|
|
|
|
|
|
|
}; |
169
|
3
|
50
|
|
|
|
17
|
next unless defined $editor_bits[0]; |
170
|
3
|
50
|
33
|
|
|
40
|
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
|
|
|
|
|
7
|
foreach my $dir (@path) { |
176
|
27
|
|
|
|
|
143
|
my $file = File::Spec->catfile($dir, $editor_bits[0]); |
177
|
27
|
50
|
|
|
|
178
|
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
|
|
|
|
110
|
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__ |