line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test::MockCommand; |
2
|
18
|
|
|
18
|
|
1066909
|
use warnings; |
|
18
|
|
|
|
|
191
|
|
|
18
|
|
|
|
|
499
|
|
3
|
18
|
|
|
18
|
|
78
|
use strict; |
|
18
|
|
|
|
|
30
|
|
|
18
|
|
|
|
|
388
|
|
4
|
|
|
|
|
|
|
|
5
|
18
|
|
|
18
|
|
79
|
use Carp qw(carp croak); |
|
18
|
|
|
|
|
27
|
|
|
18
|
|
|
|
|
881
|
|
6
|
18
|
|
|
18
|
|
8989
|
use Data::Dumper; |
|
18
|
|
|
|
|
99045
|
|
|
18
|
|
|
|
|
1017
|
|
7
|
18
|
|
|
18
|
|
6503
|
use Symbol; |
|
18
|
|
|
|
|
11011
|
|
|
18
|
|
|
|
|
972
|
|
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
# Not all systems implement the WIFEXITED/WEXITSTATUS macros |
10
|
18
|
|
|
18
|
|
7158
|
use POSIX qw(WIFEXITED WEXITSTATUS); |
|
18
|
|
|
|
|
94060
|
|
|
18
|
|
|
|
|
97
|
|
11
|
|
|
|
|
|
|
eval { WIFEXITED(0); }; |
12
|
|
|
|
|
|
|
if ($@ =~ /not (?:defined|a valid|implemented)/) { |
13
|
18
|
|
|
18
|
|
22550
|
no warnings 'redefine'; |
|
18
|
|
|
|
|
38
|
|
|
18
|
|
|
|
|
1588
|
|
14
|
|
|
|
|
|
|
*WIFEXITED = sub { not $_[0] & 0xff }; |
15
|
|
|
|
|
|
|
*WEXITSTATUS = sub { $_[0] >> 8 }; |
16
|
|
|
|
|
|
|
} |
17
|
|
|
|
|
|
|
|
18
|
18
|
|
|
18
|
|
20941
|
use Test::MockCommand::Recorder; |
|
18
|
|
|
|
|
46
|
|
|
18
|
|
|
|
|
468
|
|
19
|
18
|
|
|
18
|
|
95
|
use Test::MockCommand::Result; |
|
18
|
|
|
|
|
33
|
|
|
18
|
|
|
|
|
316
|
|
20
|
18
|
|
|
18
|
|
79
|
use Test::MockCommand::ScalarReadline qw(scalar_readline); |
|
18
|
|
|
|
|
30
|
|
|
18
|
|
|
|
|
16582
|
|
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
our $VERSION = '0.05'; |
23
|
|
|
|
|
|
|
our $CLASS = __PACKAGE__; |
24
|
|
|
|
|
|
|
our $OPEN_HANDLER = undef; # this gets set to _default_open_handler |
25
|
|
|
|
|
|
|
our $RECORDING = 0; # are we recording commands or playing them back? |
26
|
|
|
|
|
|
|
our $RECORDING_TO = undef; # where to save results when the program ends |
27
|
|
|
|
|
|
|
our %COMMANDS; # results db: $COMMANDS{$cmd} = [ $result, ... ] |
28
|
|
|
|
|
|
|
our @RECORDERS = ( Test::MockCommand::Recorder->new() ); |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
#carp "WARNING: need perl v5.9.5 or better to mock qx// and backticks" |
31
|
|
|
|
|
|
|
# if $] < 5.009005; |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
$CLASS->open_handler(undef); # set up _default_open_handler |
34
|
|
|
|
|
|
|
$CLASS->_hook_core_functions(); |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub import { |
37
|
18
|
100
|
100
|
18
|
|
358
|
if (@_ >= 3 && $_[1] eq 'record') { |
|
|
100
|
66
|
|
|
|
|
38
|
3
|
|
|
|
|
12
|
$CLASS->auto_save($_[2]); |
39
|
3
|
|
|
|
|
6
|
$CLASS->recording(1); |
40
|
|
|
|
|
|
|
} |
41
|
|
|
|
|
|
|
elsif (@_ >= 3 && $_[1] eq 'playback') { |
42
|
1
|
|
|
|
|
3
|
$CLASS->load($_[2]); |
43
|
|
|
|
|
|
|
} |
44
|
|
|
|
|
|
|
} |
45
|
|
|
|
|
|
|
|
46
|
18
|
|
|
18
|
|
16019
|
END { $CLASS->_do_autosave(); } |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
sub _do_autosave { |
49
|
19
|
|
|
19
|
|
95
|
my $class = shift; |
50
|
19
|
100
|
|
|
|
440
|
$class->save($RECORDING_TO) if defined $RECORDING_TO; |
51
|
|
|
|
|
|
|
|
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# hook into core functions that can execute external commands |
55
|
|
|
|
|
|
|
sub _hook_core_functions { |
56
|
18
|
|
|
18
|
|
28
|
my $class = shift; |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
*CORE::GLOBAL::system = sub { |
59
|
14
|
|
|
14
|
|
1598
|
my $cmd = join(' ', @_); |
60
|
14
|
|
|
|
|
123
|
return $class->_handle('system', $cmd, \@_, [caller()]); |
61
|
18
|
|
|
|
|
83
|
}; |
62
|
|
|
|
|
|
|
|
63
|
|
|
|
|
|
|
*CORE::GLOBAL::exec = sub { |
64
|
1
|
|
|
1
|
|
7
|
my $cmd = join(' ', @_); |
65
|
1
|
|
|
|
|
12
|
return $class->_handle('exec', $cmd, \@_, [caller()]); |
66
|
18
|
|
|
|
|
52
|
}; |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
*CORE::GLOBAL::readpipe = sub { |
69
|
38
|
|
|
38
|
|
5309
|
my $cmd = $_[-1]; |
70
|
38
|
|
|
|
|
514
|
return $class->_handle('readpipe', $cmd, \@_, [caller()]); |
71
|
18
|
|
|
|
|
47
|
}; |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
*CORE::GLOBAL::open = sub (*;$@) { |
74
|
68
|
50
|
|
68
|
|
30650
|
croak "Not enough arguments for open()" unless @_ > 0; |
75
|
|
|
|
|
|
|
# handle open()s that invoke a command |
76
|
68
|
100
|
|
|
|
230
|
if (@_ < 3) { |
77
|
|
|
|
|
|
|
# 1/2-arg open() |
78
|
58
|
|
|
|
|
228
|
my $file = $_[-1]; |
79
|
58
|
50
|
|
|
|
432
|
croak "Can't open bidirectional pipe" if $file =~/^\s*\|(.+)\|\s*$/; |
80
|
58
|
50
|
|
|
|
177
|
return $class->_handle('open', $1, \@_, [caller()]) |
81
|
|
|
|
|
|
|
if $file =~ /^\s*\|\s*(.+?)\s*$/; |
82
|
58
|
100
|
|
|
|
810
|
return $class->_handle('open', $1, \@_, [caller()]) |
83
|
|
|
|
|
|
|
if $file =~ /^\s*(.+?)\s*\|\s*$/; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
else { |
86
|
|
|
|
|
|
|
# 3-arg open() |
87
|
10
|
50
|
|
|
|
25
|
return $class->_handle('open', join(' ', splice(@_, 2)), \@_, |
88
|
|
|
|
|
|
|
[caller()]) |
89
|
|
|
|
|
|
|
if $_[1] =~ /^\s*-\|/; |
90
|
10
|
50
|
|
|
|
22
|
return $class->_handle('open', join(' ', splice(@_, 2)), \@_, |
91
|
|
|
|
|
|
|
[caller()]) |
92
|
|
|
|
|
|
|
if $_[1] =~ /^\s*\|-/; |
93
|
|
|
|
|
|
|
} |
94
|
|
|
|
|
|
|
|
95
|
|
|
|
|
|
|
# pass through the rest |
96
|
39
|
|
|
|
|
208
|
return $OPEN_HANDLER->(\@_, caller()); |
97
|
18
|
|
|
|
|
83
|
}; |
98
|
|
|
|
|
|
|
} |
99
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
sub _handle { |
101
|
82
|
|
|
82
|
|
610
|
my ($class, $func, $cmd, $args, $caller) = @_; |
102
|
|
|
|
|
|
|
|
103
|
82
|
|
|
|
|
486
|
my %args = ( |
104
|
|
|
|
|
|
|
command => $cmd, |
105
|
|
|
|
|
|
|
function => $func, |
106
|
|
|
|
|
|
|
arguments => $args, |
107
|
|
|
|
|
|
|
caller => $caller, |
108
|
|
|
|
|
|
|
); |
109
|
|
|
|
|
|
|
|
110
|
82
|
|
|
|
|
163
|
my $result = undef; |
111
|
82
|
|
|
|
|
180
|
my $return = undef; |
112
|
|
|
|
|
|
|
|
113
|
82
|
100
|
|
|
|
253
|
if ($RECORDING) { |
114
|
|
|
|
|
|
|
# recording mode: find a capable recorder |
115
|
52
|
|
|
|
|
164
|
for my $recorder (@RECORDERS) { |
116
|
53
|
|
|
|
|
652
|
$result = $recorder->handle(%args); |
117
|
53
|
100
|
|
|
|
857
|
last if defined $result; |
118
|
|
|
|
|
|
|
} |
119
|
|
|
|
|
|
|
|
120
|
52
|
50
|
|
|
|
211
|
if ($result) { |
121
|
|
|
|
|
|
|
# save result in database |
122
|
52
|
|
100
|
|
|
929
|
$COMMANDS{"$func:$cmd"} ||= []; |
123
|
52
|
|
|
|
|
135
|
push @{$COMMANDS{"$func:$cmd"}}, $result; |
|
52
|
|
|
|
|
1313
|
|
124
|
52
|
|
|
|
|
223
|
$return = $result->return_value(); |
125
|
|
|
|
|
|
|
} |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
else { |
128
|
|
|
|
|
|
|
# not in recording mode; look up results database instead. |
129
|
30
|
|
|
|
|
188
|
my @possible = $class->find(%args); |
130
|
30
|
100
|
|
|
|
218
|
if (@possible) { |
131
|
29
|
|
|
|
|
146
|
$result = $possible[0]; |
132
|
29
|
|
|
|
|
457
|
$return = $result->handle(%args, all_results => \@possible); |
133
|
|
|
|
|
|
|
} |
134
|
|
|
|
|
|
|
} |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
# warn and pass through if no matching commands |
137
|
82
|
100
|
|
|
|
329
|
if (! defined $result) { |
138
|
1
|
|
|
|
|
336
|
carp "can't mock $func() command \"$cmd\", passing through"; |
139
|
1
|
50
|
|
|
|
7
|
return $OPEN_HANDLER->($args, $caller->[0]) if $func eq 'open'; |
140
|
1
|
50
|
|
|
|
4
|
return CORE::readpipe(@{$args}) if $func eq 'readpipe'; |
|
0
|
|
|
|
|
0
|
|
141
|
1
|
50
|
|
|
|
15
|
return CORE::system(@{$args}) if $func eq 'system'; |
|
1
|
|
|
|
|
4039
|
|
142
|
0
|
0
|
|
|
|
0
|
return CORE::exec(@{$args}) if $func eq 'exec'; |
|
0
|
|
|
|
|
0
|
|
143
|
|
|
|
|
|
|
} |
144
|
|
|
|
|
|
|
|
145
|
|
|
|
|
|
|
# if exec() was called, save the db and exit |
146
|
81
|
100
|
|
|
|
310
|
if ($func eq 'exec') { |
147
|
1
|
|
|
|
|
8
|
$class->_do_autosave(); |
148
|
1
|
|
|
|
|
8
|
my $code = $result->exit_code(); |
149
|
1
|
50
|
|
|
|
956
|
exit(WIFEXITED($code) ? WEXITSTATUS($code) : $code); |
150
|
|
|
|
|
|
|
} |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
# readpipe() emulation should always return a scalar, so |
153
|
|
|
|
|
|
|
# emulation of $/ behaviour is used in list context |
154
|
80
|
100
|
100
|
|
|
1058
|
return scalar_readline($return) if $func eq 'readpipe' && wantarray(); |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
# return with the function's result |
157
|
53
|
|
|
|
|
1458
|
return $return; |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
# this is the default $OPEN_HANDLER, use for any non-command-executing |
161
|
|
|
|
|
|
|
# open(), also for command-executing open()s when there's no matching |
162
|
|
|
|
|
|
|
# recorder or result |
163
|
|
|
|
|
|
|
sub _default_open_handler { |
164
|
28
|
|
|
28
|
|
76
|
my ($args, $pkg) = @_; |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
# we might need to use a bareword symbol reference in the open() call |
167
|
18
|
|
|
18
|
|
124
|
no strict 'refs'; |
|
18
|
|
|
|
|
47
|
|
|
18
|
|
|
|
|
19103
|
|
168
|
|
|
|
|
|
|
|
169
|
|
|
|
|
|
|
# if defined, open()'s file handle is a bareword symbol reference which |
170
|
|
|
|
|
|
|
# should be qualified as being in the calling package's namespace. |
171
|
28
|
100
|
|
|
|
108
|
my $ref = defined($args->[0]) ? Symbol::qualify($args->[0], $pkg) : undef; |
172
|
|
|
|
|
|
|
|
173
|
|
|
|
|
|
|
# open() is finicky about its arguments, it doesn't like just @{$args}. |
174
|
|
|
|
|
|
|
# If the file handle is undefined, we refer directly to it so that open() |
175
|
|
|
|
|
|
|
# can use the pass-by-reference to assign a new value into it. |
176
|
28
|
50
|
0
|
|
|
203
|
return CORE::open($ref || $args->[0]) if @{$args} == 1; |
|
28
|
|
|
|
|
96
|
|
177
|
28
|
100
|
66
|
|
|
51
|
return CORE::open($ref || $args->[0], $args->[1]) if @{$args} == 2; |
|
28
|
|
|
|
|
1235
|
|
178
|
7
|
|
66
|
|
|
37
|
return CORE::open($ref || $args->[0], $args->[1], splice(@{$args}, 2)); |
|
7
|
|
|
|
|
273
|
|
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
sub clear { |
182
|
8
|
|
|
8
|
1
|
2095
|
%COMMANDS = (); |
183
|
|
|
|
|
|
|
} |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
sub load { |
186
|
6
|
|
|
6
|
1
|
1137
|
my $class = shift; |
187
|
6
|
|
|
|
|
14
|
my $file = shift; |
188
|
6
|
100
|
|
|
|
179
|
croak "no file specified" unless defined $file; |
189
|
|
|
|
|
|
|
|
190
|
5
|
|
|
|
|
27
|
$class->clear(); |
191
|
5
|
|
|
|
|
23
|
$class->merge($file); |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
|
|
|
|
|
|
sub merge { |
195
|
10
|
|
|
10
|
1
|
756
|
my $class = shift; |
196
|
10
|
|
|
|
|
22
|
my $file = shift; |
197
|
10
|
100
|
|
|
|
90
|
croak "no file specified" unless defined $file; |
198
|
9
|
100
|
|
|
|
265
|
croak "$file is a directory" if -d $file; |
199
|
|
|
|
|
|
|
|
200
|
|
|
|
|
|
|
# read and evaluate file, which should set up $VAR1 |
201
|
7
|
|
|
|
|
1075
|
my $VAR1 = undef; |
202
|
7
|
|
|
|
|
31
|
local $/; # enable slurp mode |
203
|
7
|
100
|
|
|
|
355
|
open(my $fh, '<', $file) or croak "can't open $file: $!"; |
204
|
5
|
|
|
|
|
588
|
eval <$fh>; |
205
|
5
|
|
|
|
|
58
|
close $fh; |
206
|
5
|
50
|
|
|
|
19
|
croak "failure loading $file: $@" if $@; |
207
|
5
|
50
|
|
|
|
568
|
croak "failure loading $file: \$VAR1 not defined" unless defined $VAR1; |
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
# merge $VAR1 into %COMMANDS |
210
|
5
|
|
|
|
|
12
|
for my $cmd (keys %{$VAR1}) { |
|
5
|
|
|
|
|
26
|
|
211
|
8
|
|
100
|
|
|
41
|
$COMMANDS{$cmd} ||= []; |
212
|
8
|
|
|
|
|
39
|
push @{$COMMANDS{$cmd}}, @{$VAR1->{$cmd}}; |
|
8
|
|
|
|
|
14
|
|
|
8
|
|
|
|
|
50
|
|
213
|
|
|
|
|
|
|
} |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
|
216
|
|
|
|
|
|
|
sub save { |
217
|
7
|
|
|
7
|
1
|
62
|
my $class = shift; |
218
|
7
|
|
|
|
|
32
|
my $file = shift; |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
# use auto-save file if no file specified |
221
|
7
|
50
|
|
|
|
44
|
$file = $RECORDING_TO unless defined $file; |
222
|
7
|
50
|
|
|
|
43
|
croak "no file specified and auto-save not enabled" unless defined $file; |
223
|
|
|
|
|
|
|
|
224
|
7
|
50
|
|
|
|
635
|
open FH, ">$file" or croak "can't save to $file: $!"; |
225
|
7
|
50
|
|
|
|
115
|
print FH Dumper(\%COMMANDS) or croak "can't write results to $file: $!"; |
226
|
7
|
50
|
|
|
|
3818
|
close FH or croak "can't close $file: $!"; |
227
|
|
|
|
|
|
|
} |
228
|
|
|
|
|
|
|
|
229
|
|
|
|
|
|
|
sub add_recorder { |
230
|
2
|
|
|
2
|
1
|
22
|
my $class = shift; |
231
|
2
|
|
33
|
|
|
10
|
my $recorder = shift || croak 'no recorder provided'; |
232
|
2
|
50
|
|
|
|
7
|
croak "recorder has no handle() method" |
233
|
|
|
|
|
|
|
unless UNIVERSAL::can($recorder, 'handle'); |
234
|
2
|
|
|
|
|
5
|
unshift @RECORDERS, $recorder; |
235
|
|
|
|
|
|
|
} |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
sub remove_recorder { |
238
|
1
|
|
|
1
|
1
|
629
|
my $class = shift; |
239
|
1
|
|
33
|
|
|
4
|
my $recorder = shift || croak 'no recorder provided'; |
240
|
1
|
|
|
|
|
2
|
@RECORDERS = grep { $_ != $recorder } @RECORDERS; |
|
3
|
|
|
|
|
12
|
|
241
|
|
|
|
|
|
|
} |
242
|
|
|
|
|
|
|
|
243
|
|
|
|
|
|
|
sub recorders { |
244
|
2
|
|
|
2
|
1
|
10
|
return @RECORDERS; |
245
|
|
|
|
|
|
|
} |
246
|
|
|
|
|
|
|
|
247
|
|
|
|
|
|
|
sub find { |
248
|
68
|
|
|
68
|
1
|
278
|
my $class = shift; |
249
|
68
|
50
|
|
|
|
308
|
croak "odd number of parameters" if @_ % 2; |
250
|
68
|
|
|
|
|
323
|
my %args = @_; |
251
|
|
|
|
|
|
|
|
252
|
68
|
|
|
|
|
125
|
my @keys; |
253
|
68
|
100
|
|
|
|
253
|
if (exists $args{command}) { |
254
|
54
|
100
|
|
|
|
231
|
if (ref $args{command} eq 'Regexp') { |
255
|
|
|
|
|
|
|
my $re = exists $args{function} |
256
|
11
|
100
|
|
|
|
120
|
? qr/^\Q$args{function}\E:(.+)/ |
257
|
|
|
|
|
|
|
: qr/^(?:exec|open|readpipe|system):(.+)/; |
258
|
11
|
100
|
|
|
|
45
|
@keys = grep { $_ =~ $re && $1 =~ $args{command} } keys %COMMANDS; |
|
33
|
|
|
|
|
446
|
|
259
|
|
|
|
|
|
|
} |
260
|
|
|
|
|
|
|
else { |
261
|
55
|
|
|
|
|
277
|
@keys = grep {exists $COMMANDS{$_}} map {"$_:$args{command}"} |
|
55
|
|
|
|
|
233
|
|
262
|
|
|
|
|
|
|
(exists $args{function} |
263
|
|
|
|
|
|
|
? ($args{function}) |
264
|
43
|
100
|
|
|
|
200
|
: qw(exec open readpipe system)); |
265
|
|
|
|
|
|
|
} |
266
|
|
|
|
|
|
|
} |
267
|
|
|
|
|
|
|
else { |
268
|
14
|
|
|
|
|
56
|
@keys = keys %COMMANDS; |
269
|
14
|
100
|
|
|
|
43
|
@keys = grep {/^\Q$args{function}\E:/} @keys if exists $args{function}; |
|
12
|
|
|
|
|
128
|
|
270
|
|
|
|
|
|
|
} |
271
|
|
|
|
|
|
|
|
272
|
|
|
|
|
|
|
# we can't just return sort{} grep{}... as the expression gives |
273
|
|
|
|
|
|
|
# undef when the caller wants a scalar context... why? |
274
|
68
|
|
|
|
|
135
|
my %score; |
275
|
586
|
|
|
|
|
1947
|
my @results = sort { $score{$b} <=> $score{$a} } |
276
|
340
|
|
|
|
|
3435
|
grep { $score{$_} = $_->matches(%args) } |
277
|
68
|
|
|
|
|
161
|
map { @{$COMMANDS{$_}} } |
|
79
|
|
|
|
|
109
|
|
|
79
|
|
|
|
|
275
|
|
278
|
|
|
|
|
|
|
@keys; |
279
|
68
|
|
|
|
|
2389
|
return @results; |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
sub all_commands { |
283
|
11
|
|
|
11
|
1
|
3422
|
return map { @{$_} } values %COMMANDS; |
|
20
|
|
|
|
|
45
|
|
|
20
|
|
|
|
|
98
|
|
284
|
|
|
|
|
|
|
} |
285
|
|
|
|
|
|
|
|
286
|
|
|
|
|
|
|
sub recording { |
287
|
30
|
|
|
30
|
1
|
8744
|
my $class = shift; |
288
|
30
|
100
|
|
|
|
136
|
if (@_ >= 1) { |
289
|
25
|
50
|
|
|
|
81
|
croak 'value to recording() not valid' unless defined $_[0]; |
290
|
25
|
|
|
|
|
48
|
$RECORDING = shift; |
291
|
|
|
|
|
|
|
} |
292
|
30
|
|
|
|
|
106
|
return $RECORDING; |
293
|
|
|
|
|
|
|
} |
294
|
|
|
|
|
|
|
|
295
|
|
|
|
|
|
|
sub auto_save { |
296
|
15
|
|
|
15
|
1
|
806
|
my $class = shift; |
297
|
15
|
100
|
|
|
|
55
|
$RECORDING_TO = shift if @_ >= 1; |
298
|
15
|
|
|
|
|
304
|
return $RECORDING_TO; |
299
|
|
|
|
|
|
|
} |
300
|
|
|
|
|
|
|
|
301
|
|
|
|
|
|
|
sub open_handler { |
302
|
22
|
|
|
22
|
1
|
1168
|
my $class = shift; |
303
|
22
|
50
|
|
|
|
69
|
croak 'wrong number of parameters' unless @_ == 1; |
304
|
22
|
100
|
|
|
|
65
|
if (defined $_[0]) { |
305
|
3
|
50
|
|
|
|
10
|
croak 'parameter must be coderef' unless ref $_[0] eq 'CODE'; |
306
|
3
|
|
|
|
|
9
|
$OPEN_HANDLER = $_[0]; |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
else { |
309
|
19
|
|
|
|
|
44
|
$OPEN_HANDLER = \&_default_open_handler; |
310
|
|
|
|
|
|
|
} |
311
|
|
|
|
|
|
|
} |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
1; |
314
|
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
__END__ |