File Coverage

blib/lib/Config/Crontab.pm
Criterion Covered Total %
statement 615 670 91.7
branch 293 376 77.9
condition 32 51 62.7
subroutine 83 86 96.5
pod 12 12 100.0
total 1035 1195 86.6


line stmt bran cond sub pod time code
1             ############################################################
2             ############################################################
3             ##
4             ## Scott Wiersdorf
5             ## Created: Fri May 9 14:03:01 MDT 2003
6             ## Updated: $Id$
7             ##
8             ## Config::Crontab - a crontab(5) parser
9             ##
10             ## This file contains the following classes:
11             ##
12             ## - Config::Crontab - the top level crontab object
13             ## - Config::Crontab::Block - crontab block (paragraph) handling
14             ## - Config::Crontab::Event - "5 0 * * * /bin/command"
15             ## - Config::Crontab::Env - "VAR=value"
16             ## - Config::Crontab::Comment - "## a comment"
17             ## - Config::Crontab::Base - base class from which all other
18             ## Config::Crontab classes inherit
19             ## - Config::Crontab::Container - base class from which Crontab and
20             ## Block classes inherit
21             ##
22             ############################################################
23             ############################################################
24              
25             ## to do: if -file = /etc/crontab, set system => 1
26             ## to do: if adding a non-block to a $ct file, make a block for us automatically
27              
28             ## a crontab object is a list of Block objects (see below) This class
29             ## (Config::Crontab) is for working with crontab files as a whole.
30             package Config::Crontab;
31 9     9   41084 use strict;
  9         19  
  9         262  
32 9     9   35 use warnings;
  9         14  
  9         242  
33 9     9   36 use Carp;
  9         11  
  9         655  
34 9     9   182 use 5.006_001;
  9         22  
35              
36             our @ISA = qw(Config::Crontab::Base Config::Crontab::Container);
37              
38             ## these two are for the 'write' method
39 9     9   34 use Fcntl;
  9         16  
  9         2162  
40 9     9   6150 use File::Temp qw(:POSIX);
  9         116895  
  9         15020  
41              
42             our $VERSION = '1.43';
43              
44             sub init {
45 30     30 1 41 my $self = shift;
46 30         77 my %args = @_;
47              
48 30         112 $self->file('');
49 30         74 $self->mode('block');
50 30         70 $self->squeeze(1); ## only in block mode
51 30         70 $self->strict(0);
52 30         87 $self->blocks([]);
53 30         93 $self->error('');
54 30         77 $self->system(0);
55 30         95 $self->owner('');
56 30         72 $self->owner_re( '[^a-zA-Z0-9\._-]' );
57              
58 30 100       100 $self->file( $args{'-file'}) if exists $args{'-file'};
59 30 100       66 $self->mode( $args{'-mode'}) if exists $args{'-mode'};
60 30 100       65 $self->squeeze( $args{'-squeeze'}) if exists $args{'-squeeze'};
61 30 100       63 $self->strict( $args{'-strict'}) if exists $args{'-strict'};
62 30 100       125 $self->system( $args{'-system'}) if exists $args{'-system'};
63 30 50       66 $self->owner( $args{'-owner'}) if exists $args{'-owner'};
64 30 50       62 $self->owner_re( $args{'-owner_re'}) if exists $args{'-owner_re'};
65              
66             ## auto-parse if file is specified
67 30 100       46 $self->read if $self->file;
68              
69 29         69 return 1;
70             }
71              
72             sub read {
73 35     35 1 117 my $self = shift;
74 35         60 my %args = @_;
75              
76 35 100       75 $self->file( $args{'-file'}) if exists $args{'-file'};
77 35 50       78 $self->mode( $args{'-mode'}) if exists $args{'-mode'};
78 35 50       88 $self->squeeze( $args{'-squeeze'}) if exists $args{'-squeeze'};
79 35 50       71 $self->strict( $args{'-strict'}) if exists $args{'-strict'};
80 35 50       64 $self->system( $args{'-system'}) if exists $args{'-system'};
81 35 50       78 $self->owner( $args{'-owner'}) if exists $args{'-owner'};
82 35 50       72 $self->owner_re( $args{'-owner_re'}) if exists $args{'-owner_re'};
83              
84             ## set default system crontab
85 35 50 66     62 if( $self->system && ! $self->file ) {
86 0         0 $self->file('/etc/crontab');
87             }
88              
89 35         49 my $fh;
90              
91             ## parse the file accordingly
92 35 100       64 if( $self->file ) {
93             open $fh, $self->file
94 34 100       149 or do {
95 4         8 $self->error($!);
96 4 100       7 if( $self->strict ) {
97 1         3 croak "Could not open " . $self->file . ": " . $self->error . "\n";
98             }
99 3         8 return;
100             }
101             }
102              
103             else {
104 1         3 my $crontab_cmd = "crontab -l 2>/dev/null|";
105 1 50       4 if( $self->owner ) {
106 0 0       0 if( $^O eq 'SunOS' ) {
107 0         0 $crontab_cmd = "crontab -l " . $self->owner . " 2>/dev/null|";
108             }
109             else {
110 0         0 $crontab_cmd = "crontab -u " . $self->owner . " -l 2>/dev/null|";
111             }
112             }
113             open $fh, $crontab_cmd
114 1 50       1319 or do {
115 0         0 $self->error($!);
116 0 0       0 if( $self->strict ) {
117 0         0 croak "Could not open pipe from crontab: " . $self->error . "\n";
118             }
119 0         0 return;
120             }
121             }
122              
123             ## reset internal block list and errors
124 31         191 $self->blocks([]);
125 31         90 $self->error('');
126              
127             PARSE: {
128 31         38 local $/;
  31         138  
129              
130             ## each line is a block
131 31 100       71 if( $self->mode eq 'line' ) {
    100          
132 2         3 $/ = "\n";
133             }
134              
135             ## whole file is a block
136             elsif( $self->mode eq 'file' ) {
137 2         3 $/ = undef;
138             }
139              
140             ## each paragraph (\n\n+) is a block
141             else {
142 27 100       61 $/ = ( $self->squeeze ? '' : "\n\n" );
143             }
144              
145 31         42 local $_;
146 31         10623 while( <$fh> ) {
147 213         248 chomp;
148 213         428 $self->last( new Config::Crontab::Block( -system => $self->system,
149             -data => $_ ) );
150             }
151             }
152 31         812 close $fh;
153             }
154              
155             ## this is needed for Config::Crontab::Container class methods
156             *elements = \&blocks;
157              
158             sub blocks {
159 1306     1306 1 954 my $self = shift;
160 1306         849 my $blocks = shift;
161              
162 1306 100       1871 if( ref($blocks) eq 'ARRAY' ) {
163 518         501 $self->{'_blocks'} = $blocks;
164             }
165              
166             ## return only blocks (in case of accidental non-block pushing)
167 5731         8586 return grep { UNIVERSAL::isa($_, 'Config::Crontab::Block') }
168 1306         1105 grep { ref($_) } @{$self->{'_blocks'}};
  5735         4236  
  1306         1603  
169             }
170              
171             sub select {
172 29     29 1 2351 my $self = shift;
173 29         45 my @results = ();
174 29         49 push @results, $_->select(@_) for $self->blocks;
175 29         109 @results;
176             }
177              
178             sub select_blocks {
179 4     4 1 14 my $self = shift;
180 4         9 my %crit = @_;
181 4         5 my @results = ();
182              
183 4 50       13 unless( keys %crit ) {
184 0         0 @results = $self->blocks;
185             }
186              
187 4         14 while( my($key, $value) = each %crit ) {
188 4         13 $key =~ s/^\-//; ## strip leading hyphen
189              
190 4 50       8 if( $key eq 'index' ) {
191 4 50       10 unless( defined $value ) {
192 0 0       0 if( $self->strict ) {
193 0         0 carp "index value undefined\n";
194             }
195 0         0 next;
196             }
197              
198             ## a list ref of integers
199 4 100       20 if( ref($value) eq 'ARRAY' ) {
    50          
200 1         2 push @results, @{$self->{'_blocks'}}[@$value];
  1         4  
201             }
202              
203             ## an integer
204             elsif( $value =~ /^\d+$/ ) {
205 3         4 push @results, @{$self->{'_blocks'}}[$value];
  3         13  
206             }
207              
208             else {
209 0 0       0 if( $self->strict ) {
210 0         0 carp "index value not recognized\n";
211             }
212             }
213             }
214              
215             else {
216 0 0       0 if( $self->strict ) {
217 0         0 carp "Unknown block selection type '$key'\n";
218             }
219             }
220             }
221 4         14 @results;
222             }
223              
224             sub block {
225 35     35 1 311 my $self = shift;
226 35 50       61 my $obj = shift
227             or return;
228 35         24 my $rblock;
229              
230 35         44 BLOCK: for my $block ( $self->blocks ) {
231 116         116 for my $line ( $block->lines ) {
232 148 100       261 if( $line == $obj ) {
233 30         20 $rblock = $block;
234 30         36 last BLOCK;
235             }
236             }
237             }
238              
239 35         111 return $rblock;
240             }
241              
242             sub remove {
243 228     228 1 171 my $self = shift;
244 228         219 my @objs = @_;
245              
246 228 50       365 if( @objs ) {
247 228         230 for my $obj ( @objs ) {
248 238 50 33     766 next unless defined $obj && ref($obj);
249              
250 238 100       570 unless( UNIVERSAL::isa($obj, 'Config::Crontab::Block') ) {
251 14 100       18 if( $self->block($obj) ) {
252 9         9 $self->block($obj)->remove($obj);
253             }
254              
255             ## a non-block object in our crontab file!
256             else {
257 5         4 undef $obj;
258             }
259 14         13 next;
260             }
261              
262 224         162 for my $block ( @{$self->{'_blocks'}} ) {
  224         307  
263 950 50 33     2203 next unless defined $block && ref($block);
264 950 100       1367 if( $block == $obj ) {
265 4         8 undef $block;
266             }
267             }
268             }
269              
270             ## strip out undefined objects
271 228         413 $self->blocks([ grep { defined } $self->elements ]);
  960         999  
272             }
273              
274 228         356 return $self->elements;
275             }
276              
277             ## same as 'crontab -u user file'
278             sub write {
279 5     5 1 8 my $self = shift;
280 5         5 my $file = shift;
281              
282             ## see if a file is present, allow for ''
283 5 50       17 if( defined $file ) {
284 0         0 $self->file($file);
285             }
286              
287 5 100       13 if( $self->file ) {
288 4 50       22 open my $ct, ">" . $self->file
289             or croak "Could not open " . $self->file . ": $!\n";
290 4         9 print {$ct} $self->dump;
  4         17  
291 4         235 close $ct;
292             }
293              
294             ## use a temporary filename
295             else {
296 1         2 my $tmpfile;
297             my $ct;
298 1         1 do { $tmpfile = tmpnam() }
  1         9  
299             until sysopen($ct, $tmpfile, O_RDWR|O_CREAT|O_EXCL);
300 1         601 print {$ct} $self->dump;
  1         4  
301 1         27 close $ct;
302              
303 1         1 my $crontab;
304 1 50       3 if( my $owner = $self->owner ) {
305 0         0 $crontab = `crontab -u $owner $tmpfile 2>&1`;
306             }
307             else {
308 1         14782 $crontab = `crontab $tmpfile 2>&1`;
309             }
310 1         13 chomp $crontab;
311 1         103 unlink $tmpfile;
312              
313 1 50 33     37 if( $crontab || $? ) {
314 0         0 $self->error($crontab);
315 0 0       0 if( $self->strict ) {
316 0         0 carp "Error writing crontab (crontab exited with status " .
317             ($? >> 8) . "): " . $self->error;
318             }
319 0         0 return;
320             }
321             }
322              
323 5         45 return 1;
324             }
325              
326             sub remove_tab {
327 2     2 1 5 my $self = shift;
328 2         5 my $file = shift;
329              
330             ## see if a file is present, allow for ''
331 2 50       9 if( defined $file ) {
332 0         0 $self->file($file);
333             }
334              
335 2 100       5 if( $self->file ) {
336 1         2 unlink $self->file;
337             }
338              
339             else {
340 1         3 my $output = '';
341 1 50       4 if( my $owner = $self->owner ) {
342 0         0 $output = `crontab -u $owner -r 2>&1`;
343             }
344             else {
345 1         3218 $output = `yes | crontab -r 2>&1`;
346             }
347 1         8 chomp $output;
348              
349             ## FIXME: what if no $output, but only '$?' ?
350 1 50 33     18 if( $output || $? ) {
351 0         0 $self->error($output);
352 0 0       0 if( $self->strict ) {
353 0         0 carp "Error removing crontab (crontab exited with status " .
354             ($? >> 8) ."): " . $self->error;
355             }
356 0         0 return;
357             }
358             }
359              
360 2         93 return 1;
361             }
362              
363             sub dump {
364 36     36 1 117 my $self = shift;
365 36         47 my $ret = '';
366              
367 36         61 for my $block ( $self->blocks ) {
368 203 100 100     399 $ret .= "\n" if $ret && $block->dump; ## empty blocks should not invoke a newline
369 203         275 $ret .= $block->dump;
370             }
371              
372 36         235 return $ret;
373             }
374              
375             sub owner {
376 37     37 1 377 my $self = shift;
377 37 100       68 if( @_ ) {
378 33         40 my $owner = shift;
379 33 100       74 if( $owner ) {
380 3 100       603 unless( defined( getpwnam($owner) ) ) {
381 1         6 $self->error("Unknown user: $owner");
382 1 50       3 if( $self->strict ) {
383 1         4 croak $self->error;
384             }
385 0         0 return;
386             }
387              
388 2 100       8 if( $owner =~ $self->owner_re ) {
389 1         6 $self->error("Illegal username: $owner");
390 1 50       3 if( $self->strict ) {
391 1         3 croak $self->error;
392             }
393 0         0 return;
394             }
395             }
396 31         86 $self->{_owner} = $owner;
397             }
398 35 50       87 return ( defined $self->{_owner} ? $self->{_owner} : '' );
399             }
400              
401             sub owner_re {
402 32     32 1 32 my $self = shift;
403 32 100       66 if( @_ ) {
404 30         46 my $re = shift;
405 30         247 $self->{_owner_re} = qr($re);
406             }
407 32 50       192 return ( defined $self->{_owner_re} ? $self->{_owner_re} : qr() );
408             }
409              
410             ############################################################
411             ############################################################
412              
413             =head1 NAME
414              
415             Config::Crontab - Read/Write Vixie compatible crontab(5) files
416              
417             =head1 SYNOPSIS
418              
419             use Config::Crontab;
420              
421             ####################################
422             ## making a new crontab from scratch
423             ####################################
424              
425             my $ct = new Config::Crontab;
426              
427             ## make a new Block object
428             my $block = new Config::Crontab::Block( -data => <<_BLOCK_ );
429             ## mail something to joe at 5 after midnight on Fridays
430             MAILTO=joe
431             5 0 * * Fri /bin/someprogram 2>&1
432             _BLOCK_
433              
434             ## add this block to the crontab object
435             $ct->last($block);
436              
437             ## make another block using Block methods
438             $block = new Config::Crontab::Block;
439             $block->last( new Config::Crontab::Comment( -data => '## do backups' ) );
440             $block->last( new Config::Crontab::Env( -name => 'MAILTO', -value => 'bob' ) );
441             $block->last( new Config::Crontab::Event( -minute => 40,
442             -hour => 3,
443             -command => '/sbin/backup --partition=all' ) );
444             ## add this block to crontab file
445             $ct->last($block);
446              
447             ## write out crontab file
448             $ct->write;
449              
450             ###############################
451             ## changing an existing crontab
452             ###############################
453              
454             my $ct = new Config::Crontab; $ct->read;
455              
456             ## comment out the command that runs our backup
457             $_->active(0) for $ct->select(-command_re => '/sbin/backup');
458              
459             ## save our crontab again
460             $ct->write;
461              
462             ###############################
463             ## read joe's crontab (must have root permissions)
464             ###############################
465              
466             ## same as "crontab -u joe -l"
467             my $ct = new Config::Crontab( -owner => 'joe' );
468             $ct->read;
469              
470             =head1 DESCRIPTION
471              
472             B provides an object-oriented interface to
473             Vixie-style crontab(5) files for Perl.
474              
475             A B object allows you to manipulate an ordered set
476             of B, B, or B objects (also included with this
477             package). Descriptions of these packages may be found below.
478              
479             In short, B reads and writes crontab(5) files (and
480             does a little pretty-printing too) using objects. The general idea is
481             that you create a B object and associate it with a
482             file (if unassociated, it will work over a pipe to C). From
483             there, you can add lines to your crontab object, change existing line
484             attributes, and write everything back to file.
485              
486             =over 4
487              
488             =item
489              
490             NOTE: B does I (currently) do validity checks
491             on your data (i.e., dates out of range, etc.). However, if the call
492             to B fails when you invoke B, B will return
493             I and set B with the error message returned from the
494             B command. Future development may tend toward more validity
495             checks.
496              
497             =back
498              
499             Now, to successfully navigate the module's ins and outs, we'll need a
500             little terminology lesson.
501              
502             =head2 Terminology
503              
504             B (hereafter simply B) sees a C
505             file in terms of I. A block is simply an ordered set of one
506             or more lines. Blocks are separated by two or more newlines. For
507             example, here is a crontab file with two blocks:
508              
509             ## a comment
510             30 4 * * * /bin/some_command
511            
512             ## another comment
513             ENV=some_value
514             50 9 * * 1-5 /bin/reminder --meeting=friday
515              
516             The first block contains two B objects: a
517             B object and an B object. The second block contains
518             an B object in addition to a B object and an B
519             object. The B class, then, consists of zero or more
520             B objects. B objects have these three
521             basic elements:
522              
523             =over 4
524              
525             =item B
526              
527             Any lines in a crontab that look like these are B objects:
528              
529             5 10 * * * /some/command
530             @reboot /bin/mystartup.sh
531             ## 0 0 * * Fri /disabled/command
532              
533             Notice that commented out event lines are still considered B
534             objects.
535              
536             B objects are described below in the B package
537             description. Please refer to it for details on manipulating B
538             objects.
539              
540             =item B
541              
542             Any lines in a crontab that look like these are B objects:
543              
544             MAILTO=joe
545             SOMEVAR = some_value
546             #DISABLED=env_setting
547              
548             Notice that commented out environment lines are still considered
549             B objects.
550              
551             B objects are described below in the B package description.
552             Please refer to it for details on manipulating B objects.
553              
554             =item B
555              
556             Any lines containing only whitespace or lines beginning with a pound
557             sign (but are not B or B objects) are B objects:
558              
559             ## this is a comment
560             (imagine somewhitespace here)
561              
562             B objects are described below in the B package
563             description. Please refer to it for details on manipulating B
564             objects.
565              
566             =back
567              
568             =head2 Illustration
569              
570             Here is a simple crontab file:
571              
572             MAILTO=joe@schmoe.org
573              
574             ## send reminder in April
575             3 10 * Apr Fri joe echo "Friday a.m. in April"
576              
577             The file consists of an environment variable setting (MAILTO), a
578             comment, and a command to run. After parsing the above file,
579             B would break it up into the following objects:
580              
581             +---------------------------------------------------------+
582             | Config::Crontab object |
583             | |
584             | +---------------------------------------------------+ |
585             | | Config::Crontab::Block object | |
586             | | | |
587             | | +---------------------------------------------+ | |
588             | | | Config::Crontab::Env object | | |
589             | | | | | |
590             | | | -name => MAILTO | | |
591             | | | -value => joe@schmoe.org | | |
592             | | | -data => MAILTO=joe@schmoe.org | | |
593             | | +---------------------------------------------+ | |
594             | +---------------------------------------------------+ |
595             | |
596             | +---------------------------------------------------+ |
597             | | Config::Crontab::Block object | |
598             | | | |
599             | | +---------------------------------------------+ | |
600             | | | Config::Crontab::Comment object | | |
601             | | | | | |
602             | | | -data => ## send reminder in April | | |
603             | | +---------------------------------------------+ | |
604             | | | |
605             | | +---------------------------------------------+ | |
606             | | | Config::Crontab::Event Object | | |
607             | | | | | |
608             | | | -datetime => 3 10 * Apr Fri | | |
609             | | | -special => (empty) | | |
610             | | | -minute => 3 | | |
611             | | | -hour => 10 | | |
612             | | | -dom => * | | |
613             | | | -month => Apr | | |
614             | | | -dow => Fri | | |
615             | | | -user => joe | | |
616             | | | -command => echo "Friday a.m. in April" | | |
617             | | +---------------------------------------------+ | |
618             | +---------------------------------------------------+ |
619             +---------------------------------------------------------+
620              
621             You'll notice the main Config::Crontab object encapsulates the entire
622             file. The parser found two B objects: the lone MAILTO variable
623             setting, and the comment and command (together). Two or more newlines
624             together in a crontab file constitute a block separator. This allows
625             you to logically group commands (as most people do anyway) in the
626             crontab file, and work with them as a Config::Crontab::Block objects.
627              
628             The second block consists of a B object and an B
629             object, shown are some of the data methods you can use to get or set
630             data in those objects.
631              
632             =head2 Practical Usage: A Brief Tutorial
633              
634             Now that we know what B objects look like and what
635             they're called, let's play around a little.
636              
637             Let's say we have an existing crontab on many machines that we want
638             to manage. The crontab contains some machine-dependent information
639             (e.g., timezone, etc.), so we can't just copy a file out everywhere
640             and replace the existing crontab. We need to edit each crontab
641             individually, specifically, we need to change the time when a
642             particular job runs:
643              
644             30 2 * * * /usr/local/sbin/pirate --arg=matey
645              
646             to 3:30 am because of daylight saving time (i.e., we don't want this
647             job to run twice).
648              
649             We can do something like this:
650              
651             use Config::Crontab;
652              
653             my $ct = new Config::Crontab;
654             $ct->read;
655              
656             my ($event) = $ct->select(-command_re => 'pirate --arg=matey');
657             $event->hour(3);
658              
659             $ct->write;
660              
661             All done! This shows us a couple of subtle but important points:
662              
663             =over 4
664              
665             =item *
666              
667             The B object must have its B method invoked
668             for it to read the crontab file.
669              
670             =item *
671              
672             The B
673             to return. This is why we put parentheses around I<$event> (otherwise
674             we would be putting the return value of B
675             and we would get the number of items in the list instead of the list
676             itself).
677              
678             =item *
679              
680             The I methods for B (and other) objects are usually
681             invoked the same way as their I method except with an argument.
682              
683             =item *
684              
685             We must write the crontab back out to file with the B method.
686              
687             =back
688              
689             Here's how we might do the same thing in a one-line Perl program:
690              
691             perl -MConfig::Crontab -e '$ct=new Config::Crontab; $ct->read; \
692             ($ct->select(-command_re=>"pirate --arg=matey"))[0]->hour(3); \
693             $ct->write'
694              
695             Nice! Ok. Now we need to add a new crontab entry:
696              
697             35 6 * * * /bin/alarmclock --ring
698              
699             We can do it like this:
700              
701             $event = new Config::Crontab::Event( -minute => 36,
702             -hour => 6,
703             -command => '/bin/alarmclock --ring');
704             $block = new Config::Crontab::Block;
705             $block->last($event);
706             $ct->last($block);
707              
708             or like this:
709              
710             $event = new Config::Crontab::Event( -data => '35 6 * * * /bin/alarmclock --ring' );
711             $ct->last(new Config::Crontab::Block( -lines => [$event] ));
712              
713             or like this:
714              
715             $ct->last(new Config::Crontab::Block(-data => "35 6 * * * /bin/alarmclock --ring"));
716              
717             We learn the following things from this example:
718              
719             =over 4
720              
721             =item *
722              
723             Only B objects can be added to B objects (see
724             L). B objects may be added via the B method
725             (and several other methods, including B, B, B,
726             B, and B).
727              
728             =item *
729              
730             B objects can be populated in a variety of ways, including the
731             B<-data> attribute (a string which may--and frequently does--span
732             multiple lines via a 'here' document), the B<-lines> attribute (which
733             takes a list reference), and the B method. In addition to the
734             B method, B objects use the same methods for adding and
735             moving objects that the B object does: B, B,
736             B, B, B, and B.
737              
738             =back
739              
740             After the B section, the remainder of this document
741             is a reference manual and describes the methods available (and how to
742             use them) in each of the 5 classes: B,
743             B, B,
744             B, and B. The reader
745             is also encouraged to look at the example CGI script in the F
746             directory and the (somewhat contrived) examples in the F (testing)
747             directory with this distribution.
748              
749             =head2 Module Utility
750              
751             B is a useful module by virtue of the "one-liner"
752             test. A useful module must do useful work (editing crontabs is useful
753             work) economically (i.e., useful work must be able to be done on a
754             single command-line that doesn't wrap more than twice and can be
755             understood by an adept Perl programmer).
756              
757             Graham Barr's B module (actually, most of Graham's work
758             falls in this category) is a good example of a useful module.
759              
760             So, with no more ado, here are some useful one-liners with
761             B:
762              
763             =over 4
764              
765             =item *
766              
767             uncomment all crontab events whose command contains the string 'fetchmail'
768              
769             perl -MConfig::Crontab -e '$c=new Config::Crontab; $c->read; \
770             $_->active(1) for $c->select(-command_re => "fetchmail"); $c->write'
771              
772             =item *
773              
774             remove the first crontab block that has '/bin/unwanted' as a command
775              
776             perl -MConfig::Crontab -e '$c=new Config::Crontab; $c->read; \
777             $c->remove($c->block($c->select(-command_re => "/bin/unwanted"))); \
778             $c->write'
779              
780             =item *
781              
782             reschedule the backups to run just Monday thru Friday:
783              
784             perl -MConfig::Crontab -e '$c=new Config::Crontab; $c->read; \
785             $_->dow("1-5") for $c->select(-command_re => "/sbin/backup"); $c->write'
786              
787             =item *
788              
789             reschedule the backups to run weekends too:
790              
791             perl -MConfig::Crontab -e '$c=new Config::Crontab; $c->read; \
792             $_->dow("*") for $c->select(-command_re => "/sbin/backup"); $c->write'
793              
794             =item *
795              
796             change all 'MAILTO' environment settings in this crontab to 'joe@schmoe.org':
797              
798             perl -MConfig::Crontab -e '$c=new Config::Crontab; $c->read; \
799             $_->value(q!joe@schmoe.org!) for $c->select(-name => "MAILTO"); $c->write'
800              
801             =item *
802              
803             strip all comments from a crontab:
804              
805             perl -MConfig::Crontab -e '$c=new Config::Crontab; $c->read; \
806             $c->remove($c->select(-type => "comment")); $c->write'
807              
808             =item *
809              
810             disable an entire block of commands (the block that has the word
811             'Friday' in it):
812              
813             perl -MConfig::Crontab -e '$c=new Config::Crontab; $c->read; \
814             $c->block($c->select(-data_re => "Friday"))->active(0); $c->write'
815              
816             =item *
817              
818             copy one user's crontab to another user:
819              
820             perl -MConfig::Crontab -e '$c = new Config::Crontab(-owner => "joe"); \
821             $c->read; $c->owner("mike"); $c->write'
822              
823             =back
824              
825             =head1 PACKAGE Config::Crontab
826              
827             This section describes B objects (hereafter simply
828             B objects). A B object is an abstracted way of
829             dealing with an entire B file. The B class has
830             methods to allow you to select, add, or remove B objects as
831             well as read and parse crontab files and write crontab files.
832              
833             =head2 init([%args])
834              
835             This method is called implicitly when you instantiate an object via
836             B. B takes the same arguments as B and B. If
837             the B<-file> argument is specified (and is non-false), B will
838             invoke B automatically with the B<-file> value. Use B to
839             re-initialize an object.
840              
841             Example:
842              
843             ## auto-parses foo.txt in implicit call to init
844             $ct = new Config::Crontab( -file => 'foo.txt' );
845              
846             ## re-initialize the object with default values and a new file
847             $ct->init( -file => 'bar.txt' );
848              
849             =head2 strict([boolean])
850              
851             B enforces the following constraints:
852              
853             =over 4
854              
855             =item *
856              
857             if the file specified by the B method (or B<-file> attribute in
858             B) does not exist at the time B is invoked, B sets
859             B and dies: "Could not open (filename): (reason)". If strict
860             is disabled, B returns I (B is set).
861              
862             =item *
863              
864             If the file specified by the B method (or B<-file> attribute in
865             B) cannot be written to, or the C command fails,
866             B sets B and warns: "Could not open (filename):
867             (reason)". If strict is disabled, B returns I (B is
868             set).
869              
870             =item *
871              
872             Croaks if an illegal username is specified in the B<-owner> parameter.
873              
874             =back
875              
876             Examples:
877              
878             ## disable strict (default)
879             $ct->strict(0);
880              
881             =head2 system([boolean])
882              
883             B tells B to assume that the crontab object
884             is after the pattern described in L with an extra I
885             field before the I field:
886              
887             @reboot joeuser /usr/local/bin/fetchmail -d 300
888              
889             where the given command will be executed by said user. when a crontab
890             file (e.g., F) is parsed without B enabled, the
891             I field will be lumped in with the command. When enabled, the
892             user field will be accessible in each event object via the B
893             method (see L in the B documentation below).
894              
895             =head2 owner([string])
896              
897             B sets the owner of the crontab. If you're running
898             Config::Crontab as a privileged user (e.g., "root"), you can read and
899             write user crontabs by specifying B either in the constructor,
900             during B, or using B before a B or B method
901             is called:
902              
903             $c = new Config::Crontab( -owner => 'joe' );
904             $c->read; ## reading joe's crontab
905              
906             Or another way:
907              
908             $c = new Config::Crontab;
909             $c->owner('joe');
910             $c->read; ## reading joe's crontab
911              
912             You can use this to copy a crontab from one user to another:
913              
914             $c->owner('joe');
915             $c->read;
916             $c->owner('bob');
917             $c->write;
918              
919             =head2 owner_re([regex])
920              
921             B is strict in what it will allow for a username,
922             since this information internally is passed to a shell. If the
923             username specified is not a user on the system, B
924             will set B with "Illegal username" and return I; if
925             B mode is enabled, B will croak with the same
926             error.
927              
928             Further, once the username is determined valid, the username is then
929             checked against a regular expression to thwart null string attacks and
930             other maliciousness. The default regular expression used to check for
931             a safe username is:
932              
933             /[^a-zA-Z0-9\._-]/
934              
935             If the pattern matches (i.e., if any characters other than the ones
936             above are found in the supplied username), B will
937             set B with "Illegal username" and return I. If B
938             mode is enabled, B will croak with the same error.
939              
940             $c->owner_re('[^a-zA-Z0-9_\.-#]'); ## allow # in usernames
941              
942             =head2 read([%args])
943              
944             Parses the crontab file specified by B. If B is not set
945             (or is false in some way), the crontab will be read from a pipe to
946             C. B optionally takes the same arguments as B
947             and B in C value> style lists.
948              
949             Until you B the crontab, the B object will be
950             uninitialized and will contain no data. You may re-read existing
951             objects to get new crontab data, but the object will retain whatever
952             other attributes (e.g., strict, etc.) it may have from when it was
953             initialized (or later attributes were changed) but will reset
954             B. Use B to completely refresh an object.
955              
956             If B fails, B will be set.
957              
958             Examples:
959              
960             ## reads the crontab for this UID (via crontab -l)
961             $ct = new Config::Crontab;
962             $ct->read;
963              
964             ## reads the crontab from a file
965             $ct = new Config::Crontab;
966             $ct->read( -file => '/var/cronbackups/cron1' );
967              
968             ## same thing as above
969             $ct = new Config::Crontab( -file => '/var/cronbackups/cron1' );
970             $ct->read; ## '-file' attribute already set
971              
972             ## ditto using 'file' method
973             $ct = new Config::Crontab;
974             $ct->file('/var/cronbackups/cron1');
975             $ct->read;
976              
977             ## ditto, using a pipe
978             $ct = new Config::Crontab;
979             $ct->file('cat /var/cronbackups/cron1|');
980             $ct->read;
981              
982             ## ditto, using 'read' method
983             $ct = new Config::Crontab;
984             $ct->read( -file => 'cat /var/cronbackups/cron1|');
985              
986             ## now fortified with error-checking
987             $ct->read
988             or do {
989             warn $ct->error;
990             return;
991             };
992              
993             =cut
994              
995             ## FIXME: need to say something about squeeze here, but squeeze(0)
996             ## doesn't seem to work correctly (i.e., it still squeezes the file)
997              
998             =head2 mode([mode])
999              
1000             Returns the current parsing mode for this object instance. If a mode
1001             is passed as an argument, next time this instance parses a crontab
1002             file, it will use this new mode. Valid modes are I, I
1003             (the default), or I.
1004              
1005             Example:
1006              
1007             ## re-read this crontab in 'file' mode
1008             $ct->mode('file');
1009             $ct->read;
1010              
1011             =head2 blocks([\@blocks])
1012              
1013             Returns a list of B objects in this crontab. The B
1014             method also takes an optional list reference as an argument to set
1015             this crontab's block list.
1016              
1017             Example:
1018              
1019             ## get blocks, remove comments and dump
1020             for my $block ( $ct->blocks ) {
1021             $block->remove($block->select( -type => 'comment' ) );
1022             $block->remove($block->select( -type => 'event',
1023             -active => 0 );
1024             print $block->dump;
1025             }
1026              
1027             ## one way to remove unwanted blocks from a crontab
1028             my @keepers = $ct->select( -type => 'comment',
1029             -data_re => 'keep this block' );
1030             $ct->blocks(\@keepers);
1031              
1032             ## another way to do it (notice 'nre' instead of 're')
1033             $ct->remove($ct->select( -type => 'comment',
1034             -data_nre => 'keep this block' ));
1035              
1036             =head2 select([%criteria])
1037              
1038             Returns a list of crontab lines that match the specified criteria.
1039             Multiple criteria may be specified. If no criteria are specified,
1040             B
1041              
1042             Field names should be preceded by a hyphen (though without a hyphen
1043             is acceptable too).
1044              
1045             The following criteria and associated values are available:
1046              
1047             =over 4
1048              
1049             =item * -type
1050              
1051             One of 'event', 'env', or 'comment'
1052              
1053             =item * -EfieldE
1054              
1055             The object in the block will be matched using 'eq' (string comparison)
1056             against this criterion.
1057              
1058             =item * -EfieldE_re
1059              
1060             The value of the object method specified will be matched using Perl
1061             regular expressions (see L) instead of string comparisons
1062             (uses the C<=~> operator internally).
1063              
1064             =item * -EfieldE_nre
1065              
1066             The value of the object method specified will be negatively matched
1067             using Perl regular expressions (see L) instead of string
1068             comparisons (uses the C operator internally).
1069              
1070             =back
1071              
1072             Examples:
1073              
1074             ## returns a list of comments in the crontab that matches the
1075             ## exact phrase '## I like bread'
1076             @comments = $ct->select( -type => 'comment',
1077             -data => '## I like bread' );
1078              
1079             ## returns a list of comments in the crontab that match the
1080             ## regular expression 'I like bread'
1081             @comments = $ct->select( -type => 'comment',
1082             -data_re => 'I like bread' );
1083              
1084             ## select all cron jobs likely to repeat during daylight saving
1085             @events = $ct->select( -type => 'event',
1086             -hour => '2' );
1087              
1088             ## select cron jobs that happen from 10:20 to 10:40 on Fridays
1089             @events = $ct->select( -type => 'event',
1090             -hour => '10',
1091             -minute_re => '^(?:[2-3][0-9]|40)$',
1092             -dow_re => '(?:5|Fri)' );
1093              
1094             ## select all cron jobs that execute during business hours
1095             @events = $ct->select( -type => 'event',
1096             -hour_re => '^(?:[8-9]|1[0-6])$' );
1097              
1098             ## select all cron jobs that don't execute during business hours
1099             @events = $ct->select( -type => 'event',
1100             -hour_nre => '^(?:[8-9]|1[0-6])$' );
1101              
1102             ## get all event lines in the crontab
1103             @events = $ct->select( -type => 'event' );
1104              
1105             ## get all lines in the crontab
1106             @lines => $ct->select;
1107              
1108             ## get a line: note list context, also, no 'type' specified
1109             ($line) = $ct->select( -data_re => 'start backups' );
1110              
1111             =head2 select_blocks([%criteria])
1112              
1113             Returns a list of crontab Block objects that match the specified
1114             criteria. If no criteria are specified, B behaves just
1115             like the B method, returning all blocks in the crontab object.
1116              
1117             The following criteria keys are available:
1118              
1119             =over 4
1120              
1121             =item * -index
1122              
1123             An integer or list reference of integers. Returns a list of blocks
1124             indexed by the given integer(s).
1125              
1126             Example:
1127              
1128             ## select the first block in the file
1129             @blocks = $ct->select_blocks( -index => 1 );
1130              
1131             ## select blocks 1, 5, 6, and 7
1132             @blocks = $ct->select_blocks( -index => [1, 5, 6, 7] );
1133              
1134             =back
1135              
1136             B returns B objects, which means that if you
1137             need to access data elements inside the blocks, you'll need to
1138             retrieve them using B or B
1139              
1140             ## the first block in the crontab file is an environment variable
1141             ## declaration: NAME=value
1142             @blocks = $ct->select_blocks( -index => 1 );
1143             print "This environment variable value is " . ($block[0]->lines)[0]->value . "\n";
1144              
1145             =head2 block($line)
1146              
1147             Returns the block that this line belongs to. If the line is not found
1148             in any blocks, I is returned. I<$line> must be a
1149             B, B, or
1150             B object.
1151              
1152             Examples:
1153              
1154             ## will always return undef for new objects; you'd never really do this
1155             $block = $ct->block( new Config::Crontab::Comment(-data => '## foo') );
1156              
1157             ## returns a Block object
1158             $block = $ct->block($existing_crontab_line);
1159             $block->dump;
1160              
1161             ## find and remove the block in which '/bin/baz' is executed
1162             my $event = $ct->select( -type => 'event',
1163             -command_re => '/bin/baz');
1164             $block = $ct->block($event);
1165             $ct->remove($block);
1166              
1167             =head2 remove($block)
1168              
1169             Removes a block from the crontab file (if a block is specified) or a
1170             crontab line from its block (if a crontab line object is specified).
1171              
1172             Example:
1173              
1174             ## remove this block from the crontab
1175             $ct->remove($block);
1176              
1177             ## remove just a line from its block
1178             $ct->remove($line);
1179              
1180             =head2 replace($oldblock, $newblock)
1181              
1182             Replaces I<$oldblock> with I<$newblock>. Returns I<$oldblock> if
1183             successful, I otherwise.
1184              
1185             Example:
1186              
1187             ## look for the block containing 'oldtuesday' and replace it with our new block
1188             $newblock = new Config::Crontab::Block( -data => '5 10 * * Tue /bin/tuesday' );
1189             my $oldblock = $ct->block($ct->select(-data_re => 'oldtuesday'));
1190             $ct->replace($oldblock, $newblock);
1191              
1192             =head2 up($block), down($block)
1193              
1194             These methods move a single B object up or
1195             down in the B object's internal array. If the B object
1196             is not already a member of this array, it will be added to the array
1197             in the first position (for B) and in the last position (for
1198             B. See also B and B and B and B in the
1199             B class.
1200              
1201             Example:
1202              
1203             $ct->up($block); ## move this block up one position
1204              
1205             =head2 first(@block), last(@block)
1206              
1207             These methods move the B object(s) to the
1208             first or last positions in the B object's internal array. If
1209             the block is not already a member of the array, it will be added in
1210             the first or last position respectively.
1211              
1212             Example:
1213              
1214             $ct->last(new Config::Crontab::Block( -data => <<_BLOCK_ ));
1215             ## eat ice cream
1216             5 * * * 1-5 /bin/eat --cream=ice
1217             _BLOCK_
1218              
1219             =head2 before($look_for, @blocks), after($look_for, @blocks)
1220              
1221             These methods move the B object(s) to the
1222             position immediately before or after the I<$look_for> (or reference)
1223             block in the B object's internal array.
1224              
1225             If the objects are not members of the array, they will be added before
1226             or after the reference block respectively. If the reference object
1227             does not exist in the array, the blocks will be moved (or added) to
1228             the beginning or end of the array respectively (like B and
1229             B).
1230              
1231             Example:
1232              
1233             ## search for a block containing a particular event (line)
1234             $block = $ct->block($ct->select(-command_re => '/bin/foo'));
1235              
1236             ## add the new blocks immediately after this block
1237             $ct->after($block, @new_blocks);
1238              
1239             =head2 write([$filename])
1240              
1241             Writes the crontab to the file specified by the B method. If
1242             B is not set (or is false), B will attempt to write to
1243             a temporary file and load it via the C program (e.g.,
1244             C).
1245              
1246             You may specify an optional filename as an argument to set B,
1247             which will then be used as the filename.
1248              
1249             If B fails, B will be set.
1250              
1251             Example:
1252              
1253             ## write out crontab
1254             $ct->write
1255             or do {
1256             warn "Error: " . $ct->error . "\n";
1257             return;
1258             };
1259              
1260             ## set 'file' and write simultaneously (future calls to read and
1261             ## write will use this filename)
1262             $ct->write('/var/mycronbackups/cron1.txt');
1263              
1264             ## same thing
1265             $ct->file('/var/mycronbackups/cron1.txt');
1266             $ct->write;
1267              
1268             =head2 remove_tab([file])
1269              
1270             Removes a crontab. If B is set, that file will be unlinked. If
1271             B is not set (or is false), B will attempt to remove
1272             the selected user's crontab via F or F
1273             -r> for the current user id.
1274              
1275             If B fails, B will be set.
1276              
1277             Example:
1278              
1279             $ct->remove_tab(''); ## unset file() and remove the current user's crontab
1280              
1281             =head2 error([string])
1282              
1283             Returns the last error encountered (usually during a file I/O
1284             operation). Pass an empty string to reset (calling B will also
1285             reset it).
1286              
1287             Example:
1288              
1289             print "The last error was: " . $ct->error . "\n";
1290             $ct->error('');
1291              
1292             =head2 dump
1293              
1294             Returns a string containing the crontab file.
1295              
1296             Example:
1297              
1298             ## show crontab
1299             print $ct->dump;
1300              
1301             ## same as 'crontab -l' except pretty-printed
1302             $ct = new Config::Crontab; $ct->read; print $ct->dump;
1303              
1304             =cut
1305              
1306             ############################################################
1307             ############################################################
1308              
1309             package Config::Crontab::Block;
1310 9     9   51 use strict;
  9         11  
  9         160  
1311 9     9   29 use warnings;
  9         7  
  9         219  
1312 9     9   25 use Carp;
  9         10  
  9         5062  
1313              
1314             our @ISA = qw(Config::Crontab::Base Config::Crontab::Container);
1315              
1316             sub init {
1317 244     244   178 my $self = shift;
1318 244         486 my %args = @_;
1319              
1320 244         364 $self->lines([]); ## initialize
1321 244         357 $self->strict(0);
1322 244         342 $self->system(0);
1323              
1324 244 100       376 $self->lines($args{'-lines'}) if defined $args{'-lines'};
1325 244 50       332 $self->strict($args{'-strict'}) if defined $args{'-strict'};
1326 244 100       455 $self->system($args{'-system'}) if defined $args{'-system'};
1327              
1328 244         231 my $rv = 1;
1329 244 100       347 if( defined $args{'-data'} ) {
1330 221         283 $self->lines([]);
1331 221         299 $rv = $self->data($args{'-data'});
1332             }
1333              
1334 244 50       473 return ( defined $rv ? 1 : undef );
1335             }
1336              
1337             sub data {
1338 643     643   462 my $self = shift;
1339 643         486 my $data = shift;
1340 643         603 my @lines = ();
1341              
1342 643 100       876 if( defined $data ) {
1343 226 50       359 if( ref($data) eq 'ARRAY' ) {
    100          
    50          
1344 0         0 @lines = @$data;
1345             }
1346              
1347             elsif( $data ) {
1348 210         486 @lines = split(/\n/, $data);
1349             }
1350              
1351             elsif( $data eq '' ) {
1352 16         22 @lines = ($data);
1353             }
1354              
1355             else {
1356 0         0 @lines = ();
1357             }
1358              
1359 226         263 for my $line ( @lines ) {
1360 483         346 my $obj;
1361 483 100       747 if( $obj = new Config::Crontab::Event(-data => $line,
    100          
    50          
1362             -system => $self->system) ) {
1363             }
1364              
1365             elsif( $obj = new Config::Crontab::Env(-data => $line) ) {
1366             }
1367              
1368             elsif( $obj = new Config::Crontab::Comment(-data => $line) ) {
1369             }
1370              
1371             else {
1372 0 0       0 if( $self->strict ) {
1373 0         0 carp "Skipping illegal line in block: $line\n";
1374             }
1375 0         0 next;
1376             }
1377              
1378 483         868 $self->last($obj);
1379             }
1380             }
1381              
1382 643         498 my $ret = '';
1383 643         664 for my $obj ( $self->lines ) {
1384 1394 100       1744 $ret .= "\n" if $ret; ## empty objects are empty lines, so we do a newline always
1385 1394         1543 $ret .= $obj->dump;
1386             }
1387 643 100       954 $ret .= "\n" if $ret;
1388              
1389 643         1302 return $ret;
1390             }
1391              
1392             ## this is needed for Config::Crontab::Container class methods
1393             *elements = \&lines;
1394              
1395             sub lines {
1396 4187     4187   2745 my $self = shift;
1397 4187         2589 my $objs = shift;
1398              
1399 4187 100       5459 if( ref($objs) eq 'ARRAY' ) {
1400 1548         1414 $self->{'_lines'} = $objs;
1401             }
1402              
1403 4187         2811 return @{$self->{'_lines'}};
  4187         5773  
1404             }
1405              
1406             sub select {
1407 262     262   493 my $self = shift;
1408 262         404 my %crit = @_;
1409              
1410             ## return all lines unless criteria specified
1411 262 100       422 return $self->lines
1412             unless scalar keys %crit;
1413              
1414 233         208 my @results = ();
1415 233         294 LINE: for my $line ( $self->lines ) {
1416 572         446 my $j = scalar keys %crit; ## reset keys
1417 572         1014 while( my($key,$value) = each %crit ) {
1418 637         854 $key =~ s/^\-//; ## strip leading hyphen
1419              
1420             ## FIXME: would be nice to have a negated 'type' option or a re
1421              
1422             ## special case for 'type'
1423 637 100       718 if( $key eq 'type' ) {
1424 254 100       971 if( $value eq 'event' ) {
    100          
    50          
1425 161 100       491 next LINE unless UNIVERSAL::isa($line, 'Config::Crontab::Event');
1426             }
1427             elsif( $value eq 'env' ) {
1428 27 100       84 next LINE unless UNIVERSAL::isa($line, 'Config::Crontab::Env');
1429             }
1430             elsif( $value eq 'comment' ) {
1431 66 100       238 next LINE unless UNIVERSAL::isa($line, 'Config::Crontab::Comment');
1432             }
1433             else {
1434 0 0       0 if( $self->strict ) {
1435 0         0 carp "Unknown object type '$value'\n";
1436             }
1437 0         0 next LINE;
1438             }
1439             }
1440              
1441             ## not special 'type' case
1442             else {
1443 9     9   45 no strict 'refs';
  9         10  
  9         3520  
1444 383 100       917 if( $key =~ /^(.+)_re$/ ) {
    100          
1445 239 100       555 next LINE unless $line->$1() =~ qr($value);
1446             }
1447             elsif( $key =~ /^(.+)_nre$/ ) {
1448 21 100       43 next LINE unless $line->$1() !~ qr($value);
1449             }
1450             else {
1451 123 100       247 next LINE unless $line->$key() eq $value;
1452             }
1453             }
1454              
1455             }
1456 152         172 push @results, $line;
1457             }
1458              
1459 233         690 return @results;
1460             }
1461              
1462             sub remove {
1463 549     549   387 my $self = shift;
1464 549         505 my @objs = @_;
1465              
1466 549 100       779 if( @objs ) {
1467 543         584 for my $obj ( @objs ) {
1468 557 50 33     1676 next unless defined $obj && ref($obj);
1469 557         382 for my $line ( @{$self->{'_lines'}} ) {
  557         768  
1470 1148 100 66     2622 next unless defined $line && ref($line);
1471 1103 100       1623 if( $line == $obj ) {
1472 50         50 undef $line;
1473             }
1474             }
1475             }
1476              
1477             ## strip out undefined objects
1478 543         728 $self->elements([ grep { defined } $self->elements ]);
  988         1245  
1479             }
1480              
1481 549         813 return $self->elements;
1482             }
1483              
1484             sub active {
1485 3     3   3 my $self = shift;
1486              
1487 3 50       7 return 1 unless @_;
1488              
1489 3         2 my $active = shift;
1490 3         2 local $_;
1491 3         7 $_->active($active) for $self->select(-type => 'env');
1492 3         6 $_->active($active) for $self->select(-type => 'event');
1493              
1494 3         7 return $active;
1495             }
1496              
1497             sub nolog {
1498 0     0   0 my $self = shift;
1499 0 0       0 return 1 unless @_;
1500              
1501 0         0 my $nolog = shift;
1502 0         0 local $_;
1503 0         0 $_->nolog($nolog) for $self->select(-type => 'event');
1504              
1505 0         0 return $nolog;
1506             }
1507              
1508             ############################################################
1509             ############################################################
1510              
1511             =head1 PACKAGE Config::Crontab::Block
1512              
1513             This section describes B objects (hereafter
1514             referred to as B objects). A B object is an abstracted
1515             way of dealing with groups of crontab(5) lines. Depending on how
1516             B parsed the file (see the B and B
1517             methods in B above), a block may consist of:
1518              
1519             =over 4
1520              
1521             =item a single line (e.g., a crontab event, environment setting, or comment)
1522              
1523             =item a "paragraph" of lines (a group of lines, each group separated
1524             by at least two newlines). This is the default parsing mode.
1525              
1526             =item the entire crontab file
1527              
1528             =back
1529              
1530             The default for B is to read in I (paragraph)
1531             mode. This allows you to group lines that have a similar purpose as
1532             well as order lines within a block (e.g., often you want an
1533             environment setting to take effect before certain cron commands
1534             execute).
1535              
1536             An illustration may be helpful:
1537              
1538             =over 4
1539              
1540             =item B
1541              
1542             Line Block Block Line Entry
1543             1 1 1 ## grind disks
1544             2 1 2 5 5 * * * /bin/grind
1545             3 1 3
1546              
1547             4 2 1 ## backup reminder to joe
1548             5 2 2 MAILTO=joe
1549             6 2 3 5 0 * * Fri /bin/backup
1550             7 2 4
1551              
1552             8 3 1 ## meeting reminder to bob
1553             9 3 2 MAILTO=bob
1554             10 3 3 30 9 * * Wed /bin/meeting
1555              
1556             Notice that each block has its own internal line numbering. Vertical
1557             space has been inserted between blocks to clarify block structures.
1558             Block mode parsing is the default.
1559              
1560             =item B
1561              
1562             Line Block Block Line Entry
1563             1 1 1 ## grind disks
1564             2 2 1 5 5 * * * /bin/grind
1565             3 3 1
1566             4 4 1 ## backup reminder to joe
1567             5 5 1 MAILTO=joe
1568             6 6 1 5 0 * * Fri /bin/backup
1569             7 7 1
1570             8 8 1 ## meeting reminder to bob
1571             9 9 1 MAILTO=bob
1572             10 10 1 30 9 * * Wed /bin/meeting
1573              
1574             Notice that each line is also a block. You normally don't want to
1575             read in line mode unless you don't have paragraph breaks in your
1576             crontab file (the dumper prints a newline between each block; with
1577             each line being a block you get an extra newline between each line).
1578              
1579             =item B
1580              
1581             Line Block Block Line Entry
1582             1 1 1 ## grind disks
1583             2 1 2 5 5 * * * /bin/grind
1584             3 1 3
1585             4 1 4 ## backup reminder to joe
1586             5 1 5 MAILTO=joe
1587             6 1 6 5 0 * * Fri /bin/backup
1588             7 1 7
1589             8 1 8 ## meeting reminder to bob
1590             9 1 9 MAILTO=bob
1591             10 1 10 30 9 * * Wed /bin/meeting
1592              
1593             Notice that there is only one block in file mode, and each line is a
1594             block line (but not a separate block).
1595              
1596             =back
1597              
1598             =head1 METHODS
1599              
1600             This section describes methods accessible from B objects.
1601              
1602             =head2 new([%args])
1603              
1604             Creates a new B object. You may create B objects in any
1605             of the following ways:
1606              
1607             =over 4
1608              
1609             =item Empty
1610              
1611             $event = new Config::Crontab::Block;
1612              
1613             =item Fully Populated
1614              
1615             $event = new Config::Crontab::Block( -data => <<_BLOCK_ );
1616             ## a comment
1617             5 19 * * Mon /bin/fhe --turn=dad
1618             _BLOCK_
1619              
1620             =back
1621              
1622             Constructor attributes available in the B method take the same
1623             arguments as their method counterparts (described below), except that
1624             the names of the attributes must have a hyphen ('-') prepended to the
1625             attribute name (e.g., 'lines' becomes '-lines'). The following is a
1626             list of attributes available to the B method:
1627              
1628             =over 4
1629              
1630             =item B
1631              
1632             =item B
1633              
1634             =back
1635              
1636             If the B<-data> attribute is present in the constructor when other
1637             attributes are also present, the B<-data> attribute will override all
1638             other attributes.
1639              
1640             Each of these attributes corresponds directly to its similarly-named
1641             method.
1642              
1643             Examples:
1644              
1645             ## create an empty block object & populate it with the data method
1646             $block = new Config::Crontab::Block;
1647             $block->data( <<_BLOCK_ ); ## via a 'here' document
1648             ## 2:05a Friday backup
1649             MAILTO=sysadmin@mydomain.ext
1650             5 2 * * Fri /sbin/backup /dev/da0s1f
1651             _BLOCK_
1652              
1653             ## create a block in the constructor (also via 'here' document)
1654             $block = new Config::Crontab::Block( -data => <<_BLOCK_ );
1655             ## 2:05a Friday backup
1656             MAILTO=sysadmin@mydomain.ext
1657             5 2 * * Fri /sbin/backup /dev/da0s1f
1658             _BLOCK_
1659              
1660             ## create an array of crontab objects
1661             my @lines = ( new Config::Crontab::Comment(-data => '## run bar'),
1662             new Config::Crontab::Event(-data => '5 8 * * * /foo/bar') );
1663              
1664             ## create a block object via lines attribute
1665             $block = new Config::Crontab::Block( -lines => \@lines );
1666              
1667             ## ...or with lines method
1668             $block->lines(\@lines); ## @lines is an array of crontab objects
1669              
1670             If bogus data is passed to the constructor, it will return I
1671             instead of an object reference. If there is a possiblility of poorly
1672             formatted data going into the constructor, you should check the object
1673             variable for definedness before using it.
1674              
1675             If the B<-data> attribute is present in the constructor when other
1676             attributes are also present, the B<-data> attribute will override all
1677             other attributes.
1678              
1679             =head2 data([string])
1680              
1681             Get or set a raw block. Internally, B passes its arguments to
1682             other objects for parsing when a parameter is present.
1683              
1684             Example:
1685              
1686             ## re-initialize this block
1687             $block->data("## comment\n5 * * * * /bin/checkup");
1688              
1689             print $block->data;
1690              
1691             Block data is terminated with a final newline.
1692              
1693             =head2 lines([\@objects])
1694              
1695             Get block data as a list of B objects. Set block
1696             data using a list reference.
1697              
1698             Example:
1699              
1700             $block->lines( [ new Config::Crontab::Comment( -data => "## run backup" ),
1701             new Config::Crontab::Event( -data => "5 4 * * 1-5 /sbin/backup" ) ] );
1702              
1703             ## sorta like $block->dump
1704             for my $obj ( $block->lines ) {
1705             print $obj->dump . "\n";
1706             }
1707              
1708             ## a clumsy way to "unshift" a new event
1709             $block->lines( [new Config::Crontab::Comment(-data => '## hi mom!'),
1710             $block->lines] );
1711              
1712             ## the right way to add a new event
1713             $block->first( new Config::Crontab::Comment(-data => '## hi mom!') );
1714             print $_->dump for $block->lines;
1715              
1716             =head2 select([%criteria])
1717              
1718             Returns a list of B, B, or B objects from a block
1719             that match the specified criteria. Multiple criteria may be specified.
1720              
1721             Field names should be preceded by a hyphen (though without a hyphen
1722             is acceptable too; we use hyphens to avoid the need for quoting keys
1723             and avoid potential bareword collisions).
1724              
1725             If not criteria are specified, B
1726             in the block (like B).
1727              
1728             Example:
1729              
1730             ## select all events
1731             for my $event ( $block->select( -type => 'event') ) {
1732             print $event->dump . "\n";
1733             }
1734              
1735             ## select events that have the word 'foo' in the command
1736             for my $event ( $block->select( -type => 'event', -command_re => 'foo') ) {
1737             print $event->dump . "\n";
1738             }
1739              
1740             =head2 remove(@objects)
1741              
1742             Remove B objects from this block.
1743              
1744             Example:
1745              
1746             ## simple case: you need to get a handle on these objects first
1747             $block->remove( $obj1, $obj2, $obj3 );
1748              
1749             ## more complex: remove an event from a block by searching
1750             for my $event ( $block->select( -type => 'event') ) {
1751             next unless $event->command =~ /\bbackup\b/; ## look for backup command
1752             $block->remove($event); last; ## and remove it
1753             }
1754              
1755             =head2 replace($oldobj, $newobj)
1756              
1757             Replaces I<$oldobj> with I<$newobj> within a block. Returns I<$oldobj>
1758             if successful, I otherwise.
1759              
1760             Example:
1761              
1762             ## replace $event1 with $event2 in this block.
1763             ## '=>' is the same as a comma (,)
1764             ($event1) = $block->select(-type => 'event', -command => '/bin/foo');
1765             $event2 = new Config::Crontab::Event( -data => '5 2 * * * /bin/bar' );
1766             ok( $block->replace($event1 => $event2) );
1767              
1768             =head2 up($target_obj), down($target_obj)
1769              
1770             These methods move the B object up or down within
1771             the block.
1772              
1773             If the object is not a member of the block, it will be added to the
1774             block in the first position for B and it will be added to the
1775             block in the last position for B.
1776              
1777             Examples:
1778              
1779             $block->up($event); ## move event up one position in the block
1780              
1781             ## add a new event at the end of the block
1782             $block->down(new Config::Crontab::Event(-data => '5 2 * * Mon /bin/monday'));
1783              
1784             =head2 first(@target_obj), last(@target_obj)
1785              
1786             These methods move the B object(s) to the first
1787             or last positions in the block.
1788              
1789             If the object or objects are not members of the block, they will be
1790             added to the first or last part of the block respectively.
1791              
1792             Examples:
1793              
1794             $block->first($comment); ## move $comment to the first line in this block
1795              
1796             ## add these new events to the end of the block
1797             $block->last( new Config::Crontab::Comment(-data => '## hi mom!'),
1798             new Config::Crontab::Comment(-data => '## hi dad!'), );
1799              
1800             =head2 before($look_for, @obj), after($look_for, @obj)
1801              
1802             These methods move the B object(s) to the position
1803             immediately before or after the I<$look_for> (or reference) object
1804             in the block.
1805              
1806             If the objects are not members of the block, they will be added
1807             to the block before or after the reference object. If the reference
1808             object does not exist in the block, the objects will be moved (or
1809             added) to the beginning or end of the block respectively (much the
1810             same as B and B).
1811              
1812             ## simple example
1813             $block->after($event, $comment); ## move $comment after $event in this block
1814              
1815             =head2 active(boolean)
1816              
1817             Activates or deactivates an entire block. If no arguments are given,
1818             B returns true but does nothing, otherwise the boolean used
1819             to activate or deactivate the block is returned.
1820              
1821             If you have a series of related crontab lines you wish to comment out
1822             (or uncomment), you can use this handy shortcut to do it. You cannot
1823             deactivate B objects (i.e., they will always be comments).
1824              
1825             Example:
1826              
1827             $block->active(0); ## deactivate this block
1828              
1829             =head2 nolog(boolean)
1830              
1831             This is (currently) a SuSE-specific extension. From B:
1832              
1833             If the uid of the owner is 0 (root), he can put a "-" as first
1834             character of a crontab entry. This will prevent cron from writing a
1835             syslog message about this command getting executed.
1836              
1837             B enables adds or removes this hyphen for a given cron event
1838             line (regardless of whether the user is I or not).
1839              
1840             Example:
1841              
1842             $block->nolog(1); ## quiet all entries in this block
1843              
1844             =head2 flag(string)
1845              
1846             Flags a block or an object inside a block with the specified data. The
1847             data you specify is completely up to you. This can be handy if you
1848             need to operate on many objects at once and don't want to risk pulling
1849             the rug out from under some (i.e., deleting numbered elements from a
1850             list changes the numbering of subsequent objects in the list, which is
1851             probably not what you want).
1852              
1853             All normal query operations apply to B<-flag> attributes (e.g.,
1854             B<-flag_re>, B<-flag_nre>, etc).
1855              
1856             Example:
1857              
1858             ## delete every other event in this block
1859             my $count = 0;
1860             for my $event ( $block->select( -type => 'event' ) ) {
1861             $event->flag('deleteme!')
1862             if $count % 2 == 0;
1863             $count++;
1864             }
1865              
1866             ## delete all blocks marked as 'deleteme!'
1867             $block->remove( $block->select( -flag => 'deleteme!' ) );
1868              
1869             =head2 dump
1870              
1871             Returns a formatted string of the B object (recursively calling
1872             all its objects' dump methods). A B dump is newline terminated.
1873              
1874             Example:
1875              
1876             print $block->dump;
1877              
1878             =cut
1879              
1880             ############################################################
1881             ############################################################
1882              
1883             package Config::Crontab::Event;
1884 9     9   48 use strict;
  9         9  
  9         161  
1885 9     9   28 use warnings;
  9         11  
  9         197  
1886 9     9   37 use Carp;
  9         10  
  9         534  
1887              
1888             our @ISA = qw(Config::Crontab::Base);
1889              
1890 9     9   31 use constant RE_DT => '(?:\d+|\*)(?:[-,\/]\d+)*';
  9         13  
  9         549  
1891 9     9   33 use constant RE_DTLIST => RE_DT . '(?:,' . RE_DT . ')*';
  9         9  
  9         392  
1892 9     9   32 use constant RE_DM => '\w{3}(?:,\w{3})*';
  9         9  
  9         414  
1893 9     9   27 use constant RE_DTELEM => '(?:\*|' . RE_DTLIST . ')';
  9         11  
  9         429  
1894 9     9   43 use constant RE_DTMOY => '(?:\*|' . RE_DTLIST . '|' . RE_DM . ')';
  9         11  
  9         333  
1895 9     9   31 use constant RE_DTDOW => RE_DTMOY;
  9         8  
  9         315  
1896 9     9   29 use constant RE_ACTIVE => '^\s*(\#*)\s*';
  9         137  
  9         351  
1897 9     9   29 use constant RE_NOLOG => '(-?)'; ## SuSE-specific extension
  9         8  
  9         307  
1898 9     9   27 use constant RE_SPECIAL => '(\@(?:reboot|midnight|(?:year|annual|month|week|dai|hour)ly))';
  9         8  
  9         568  
1899 9         316 use constant RE_DATETIME => '(' . RE_DTELEM . ')' .
1900             '\s+(' . RE_DTELEM . ')' .
1901             '\s+(' . RE_DTELEM . ')' .
1902             '\s+(' . RE_DTMOY . ')' .
1903 9     9   28 '\s+(' . RE_DTDOW . ')';
  9         8  
1904 9     9   26 use constant RE_USER => '\s+(\S+)';
  9         17  
  9         311  
1905 9     9   28 use constant RE_COMMAND => '\s+(.+?)\s*$';
  9         7  
  9         376  
1906 9     9   27 use constant SPECIAL => RE_ACTIVE . RE_NOLOG . RE_SPECIAL . RE_COMMAND;
  9         11  
  9         402  
1907 9     9   37 use constant DATETIME => RE_ACTIVE . RE_NOLOG . RE_DATETIME . RE_COMMAND;
  9         7  
  9         474  
1908 9     9   36 use constant SYS_SPECIAL => RE_ACTIVE . RE_NOLOG . RE_SPECIAL . RE_USER . RE_COMMAND;
  9         10  
  9         475  
1909 9     9   32 use constant SYS_DATETIME => RE_ACTIVE . RE_NOLOG . RE_DATETIME . RE_USER . RE_COMMAND;
  9         10  
  9         11442  
1910              
1911             sub init {
1912 524     524   371 my $self = shift;
1913 524         775 my %args = @_;
1914 524         398 my $rv = 1;
1915              
1916             ## set defaults
1917 524         633 $self->active(1);
1918 524         591 $self->nolog(0);
1919 524         589 $self->system(0);
1920              
1921 524         640 $self->special(undef);
1922 524         647 $self->minute('*');
1923 524         631 $self->hour('*');
1924 524         606 $self->dom('*');
1925 524         596 $self->month('*');
1926 524         574 $self->dow('*');
1927 524         631 $self->user('');
1928              
1929             ## get arguments and set new defaults
1930 524 100       945 $self->system($args{'-system'}) if defined $args{'-system'}; ## -system arg overrides implicits
1931 524 100       722 unless( $args{'-data'} ) {
1932 47 100       72 $self->minute($args{'-minute'}) if defined $args{'-minute'};
1933 47 100       66 $self->hour($args{'-hour'}) if defined $args{'-hour'};
1934 47 50       65 $self->dom($args{'-dom'}) if defined $args{'-dom'};
1935 47 50       58 $self->month($args{'-month'}) if defined $args{'-month'};
1936 47 50       64 $self->dow($args{'-dow'}) if defined $args{'-dow'};
1937              
1938 47 50       58 $self->user($args{'-user'}) if defined $args{'-user'};
1939 47 50       58 $self->system(1) if defined $args{'-user'};
1940              
1941 47 100       70 $self->special($args{'-special'}) if defined $args{'-special'};
1942 47 100       64 $self->datetime($args{'-datetime'}) if defined $args{'-datetime'};
1943 47 100       72 $self->command($args{'-command'}) if $args{'-command'};
1944 47 50       73 $self->active($args{'-active'}) if defined $args{'-active'};
1945 47 50       62 $self->nolog($args{'-nolog'}) if defined $args{'-nolog'};
1946             }
1947 524 100       915 $rv = $self->data($args{'-data'}) if defined $args{'-data'};
1948              
1949 524 100       1149 return ( defined $rv ? 1 : undef );
1950             }
1951              
1952             ## returns the crontab line w/o '(in)?active' pound sign (#)
1953             sub data {
1954 1240     1240   909 my $self = shift;
1955 1240         926 my $data = '';
1956              
1957 1240 100       1478 if( @_ ) {
1958 510         383 $data = shift;
1959 510 100       626 $data = '' unless $data; ## normalize false values
1960              
1961 510         481 my @matches = ();
1962              
1963             ## system (user) syntax
1964 510 100       508 if( $self->system ) {
1965 69 100 100     818 if( @matches = $data =~ SYS_SPECIAL or
1966             @matches = $data =~ SYS_DATETIME ) {
1967 43         51 my $active = shift @matches;
1968 43         41 my $nolog = shift @matches;
1969 43 100       83 $self->active( ($active ? 0 : 1) );
1970 43 100       68 $self->nolog( ($nolog ? 1 : 0) );
1971 43         56 $self->command( pop @matches );
1972 43         57 $self->user( pop @matches );
1973 43         66 $self->datetime( \@matches );
1974             }
1975              
1976             ## not a good -data value
1977             else {
1978 26         52 return;
1979             }
1980             }
1981              
1982             ## non-system (regular user crontab style) syntax
1983             else {
1984             ## is a command
1985 441 100 100     4509 if( @matches = $data =~ SPECIAL or
1986             @matches = $data =~ DATETIME ) {
1987 199         225 my $active = shift @matches;
1988 199         207 my $nolog = shift @matches;
1989 199 100       355 $self->active( ($active ? 0 : 1) );
1990 199 50       297 $self->nolog( ($nolog ? 1 : 0) );
1991 199         260 $self->command( pop @matches );
1992 199         243 $self->user('');
1993 199         264 $self->datetime( \@matches );
1994             }
1995              
1996             ## not a good -data value
1997             else {
1998 242         323 return;
1999             }
2000             }
2001             }
2002              
2003 972         951 my $fmt = "%s";
2004 972 100       1012 $fmt .= ( $self->command
    50          
    100          
    100          
2005             ? ( $self->system
2006             ? ($self->special ? "\t\t\t\t\t%s" : "\t%s") . ( $self->user ? "\t%s" : '' )
2007             : " %s" )
2008             : '' );
2009              
2010 972 100 66     1294 return sprintf($fmt, ( $self->command
    100          
2011             ? ( $self->datetime, ($self->system && $self->user ? $self->user : ()))
2012             : () ), $self->command )
2013             }
2014              
2015             sub datetime {
2016 1242     1242   878 my $self = shift;
2017 1242         769 my $data = shift;
2018 1242         1072 my @matches = ();
2019              
2020 1242 100       1521 if( $data ) {
2021             ## an array reference: when called from 'data' method
2022 252 100       374 if( ref($data) eq 'ARRAY' ) {
2023 245         444 @matches = @$data;
2024              
2025             ## likely special datetime format (e.g., @reboot, etc.)
2026 245 100       409 if( scalar(@matches) == 1 ) {
    50          
2027 29         48 $self->special( @matches );
2028 29         48 $self->minute( '*' );
2029 29         44 $self->hour( '*' );
2030 29         43 $self->dom( '*' );
2031 29         42 $self->month( '*' );
2032 29         96 $self->dow( '*' );
2033             }
2034              
2035             ## likely standard datetime format (e.g., '6 1 * * Fri', etc.)
2036             elsif( scalar @matches ) {
2037 216         282 $self->special( undef);
2038 216         265 $self->minute( shift @matches );
2039 216         279 $self->hour( shift @matches );
2040 216         297 $self->dom( shift @matches );
2041 216         266 $self->month( shift @matches );
2042 216         263 $self->dow( shift @matches );
2043             }
2044             else {
2045             ## empty array ref
2046 0         0 carp "No data in array constructor\n";
2047 0         0 return;
2048             }
2049             }
2050              
2051             ## not a reference: when called as a method directly (e.g., 'init' method)
2052             else {
2053             ## special datetime format (@reboot, @daily, etc.)
2054 7 100       50 if( @matches = $data =~ RE_SPECIAL ) {
    50          
2055 3         3 $self->special( @matches );
2056 3         3 $self->minute( '*' );
2057 3         3 $self->hour( '*' );
2058 3         3 $self->dom( '*' );
2059 3         3 $self->month( '*' );
2060 3         4 $self->dow( '*' );
2061             }
2062              
2063             ## standard datetime format ("0 5 * * Fri", etc.)
2064             elsif( @matches = $data =~ RE_DATETIME ) {
2065 4         7 $self->special( undef);
2066 4         6 $self->minute( shift @matches );
2067 4         6 $self->hour( shift @matches );
2068 4         6 $self->dom( shift @matches );
2069 4         4 $self->month( shift @matches );
2070 4         5 $self->dow( shift @matches );
2071             }
2072              
2073             ## not a valid datetime format
2074             else {
2075             ## some bad data
2076 0         0 carp "Bad datetime spec: $data\n";
2077 0         0 return;
2078             }
2079             }
2080             }
2081              
2082 1242 100       1311 if( $self->special ) {
2083 155         181 return $self->special;
2084             }
2085              
2086 1087 100       1261 my $fmt = ( $self->system
2087             ? "%s\t%s\t%s\t%s\t%s"
2088             : "%s %s %s %s %s" );
2089              
2090 1087         1181 return sprintf( $fmt, $self->minute, $self->hour, $self->dom, $self->month, $self->dow);
2091             }
2092              
2093             ## this is duplicated in AUTOLOAD, but we need to set system also
2094             sub user {
2095 1141     1141   816 my $self = shift;
2096 1141 100       1412 if( @_ ) { ## setting a value, set system too
2097 771 100       1118 $self->system($_[0] ? 1 : 0);
2098 771         864 $self->{_user} = shift;
2099             }
2100 1141 50       1885 return ( defined $self->{_user} ? $self->{_user} : '' );
2101             }
2102              
2103             sub dump {
2104 677     677   510 my $self = shift;
2105 677         548 my $rv = '';
2106              
2107 677 100       707 $rv .= ( $self->active
2108             ? ''
2109             : '#' );
2110 677 100       776 $rv .= ( $self->nolog
2111             ? '-'
2112             : '' );
2113 677         748 $rv .= $self->data;
2114 677         1424 return $rv;
2115             }
2116              
2117             ############################################################
2118             ############################################################
2119              
2120             =head1 PACKAGE Config::Crontab::Event
2121              
2122             This section describes B objects (hereafter
2123             B objects). A B object is an abstracted way of dealing
2124             with crontab(5) lines that look like any of the following (see
2125             L):
2126              
2127             =over 4
2128              
2129             =item 5 0 * 3,6,9,12 * /bin/quarterly_report
2130              
2131             =item 0 2 * * Fri $HOME/bin/cake_reminder
2132              
2133             =item @daily /bin/bar arg1 arg2
2134              
2135             =item #30 10 12 * * /bin/commented out
2136              
2137             =item 5 4 * * * joeuser /bin/winkerbean
2138              
2139             =back
2140              
2141             B objects are lines in the crontab file which trigger an event
2142             at a certain time (or set of times). This includes events that have
2143             been commented out. In B object terms, an event that has been
2144             commented out is I. Events that have not been commented out
2145             are I.
2146              
2147             =head2 Terminology
2148              
2149             The following description will serve as a terminology guide for this
2150             class:
2151              
2152             Given the following crontab event entry:
2153              
2154             5 3 * Apr Sun /bin/rejoice
2155              
2156             we define the following parts of the B object:
2157              
2158             5 3 * Apr Sun /bin/rejoice
2159             ------------- ------------
2160             datetime command
2161              
2162             We can break down the B field into the following parts:
2163              
2164             5 3 * Apr Sun
2165             ------ ---- --- ----- ---
2166             minute hour dom month dow
2167              
2168             We might also see an event with a "special" datetime part:
2169              
2170             @daily /bin/brush --teeth --feet
2171             -------- -------------------------
2172             datetime command
2173              
2174             This special datetime field can also be called 'special':
2175              
2176             @daily /bin/brush --teeth --feet
2177             ------- -------------------------
2178             special command
2179              
2180             As of version 1.05, B supports system crontabs, which adds
2181             an extra I field:
2182              
2183             5 3 * Apr Sun chris /bin/rejoice
2184             ------------- ----- ------------
2185             datetime user command
2186              
2187             This field is described in L on most systems.
2188              
2189             These and other methods for accessing and manipulating B
2190             objects are described in subsequent sections.
2191              
2192             =head1 METHODS
2193              
2194             This section describes methods available to manipulate B
2195             objects' creation and attributes.
2196              
2197             =head2 new([%args])
2198              
2199             Creates a new B object. You may create B objects in any
2200             of the following ways:
2201              
2202             =over 4
2203              
2204             =item Empty
2205              
2206             $event = new Config::Crontab::Event;
2207              
2208             =item Partially Populated
2209              
2210             $event = new Config::Crontab::Event( -minute => 0 );
2211              
2212             =item Fully Populated
2213              
2214             $event = new Config::Crontab::Event( -minute => 5,
2215             -hour => 2,
2216             -command => '/bin/document my_proggie', );
2217              
2218             =item System Event
2219              
2220             $event = new Config::Crontab::Event( -minute => 5,
2221             -hour => 2,
2222             -user => 'joeuser',
2223             -command => '/bin/foo --bar=blech', );
2224              
2225             =item System Event
2226              
2227             $event = new Config::Crontab::Event( -data => '30 3 * * 5,6 joeuser /bin/blech',
2228             -system => 1, );
2229              
2230             =back
2231              
2232             Constructor attributes available in the B method take the same
2233             arguments as their method counterparts (described below), except that
2234             the names of the attributes must have a hyphen ('-') prepended to the
2235             attribute name (e.g., 'month' becomes '-month'). The following is a
2236             list of attributes available to the B method:
2237              
2238             =over 4
2239              
2240             =item B<-minute>
2241              
2242             =item B<-hour>
2243              
2244             =item B<-dom>
2245              
2246             =item B<-month>
2247              
2248             =item B<-dow>
2249              
2250             =item B<-special>
2251              
2252             =item B<-data>
2253              
2254             =item B<-datetime>
2255              
2256             =item B<-user>
2257              
2258             =item B<-system>
2259              
2260             =item B<-command>
2261              
2262             =item B<-active>
2263              
2264             =back
2265              
2266             Each of these attributes corresponds directly to its similarly-named
2267             method.
2268              
2269             Examples:
2270              
2271             ## use datetime attribute; using a 'special' string in -datetime is
2272             ## ok, but the reverse is not true (using a standard datetime string
2273             ## in -special)
2274             $event = new Config::Crontab::Event( -datetime => '@hourly',
2275             -command => '/bin/bar' );
2276              
2277              
2278             ## use special attribute
2279             $event = new Config::Crontab::Event( -special => '@hourly',
2280             -command => '/bin/bar' );
2281              
2282              
2283             ## use datetime attribute
2284             $event = new Config::Crontab::Event( -datetime => '5 * * * Fri',
2285             -command => '/bin/bar' );
2286              
2287              
2288             ## this is an error because '5 * * * Fri' is not one of the special
2289             ## datetime strings. Currently this does not throw an error, but
2290             ## behavior is undefined for an object initialized thusly
2291             $event = new Config::Crontab::Event( -special => '5 * * * Fri',
2292             -command => '/bin/bar' );
2293              
2294              
2295             ## create an inactive Event; default for datetime fields is '*'
2296             ## the result is the line: "#0 2 * * * /bin/foo" (notice '#')
2297             $event = new Config::Crontab::Event( -active => 0,
2298             -minute => 0,
2299             -hour => 2, ## 2 am
2300             -command => '/bin/foo' );
2301             ...time passes...
2302             $event->active(1); ## now activate that event
2303              
2304              
2305             ## let the object do all the hard parsing
2306             $event = new Config::Crontab::Event( -data => '30 3 * * 5,6 /bin/blech' );
2307             ...time passes...
2308             $event->hour(4); ## change the event from 3:30a to 4:30a
2309              
2310             If bogus data is passed to the constructor, it will return I
2311             instead of an object reference. If there is a possiblility of poorly
2312             formatted data going into the constructor, you should check the object
2313             variable for definedness before using it.
2314              
2315             =head2 A note about the datetime fields
2316              
2317             B objects have several ways of setting the datetime fields:
2318              
2319             ## via the special method
2320             $event->special('@daily');
2321              
2322             ## via datetime
2323             $event->datetime('@daily');
2324              
2325             ## via datetime
2326             $event->datetime('0 0 * * *');
2327              
2328             ## via datetime fields
2329             $event->minute(0);
2330             $event->hour(0);
2331              
2332             ## via data (takes the command part also)
2333             $event->data('0 0 * * * /bin/foo');
2334              
2335             ## via the constructor at object instantiation time
2336             $event = new Config::Crontab::Event( -special => '@reboot' );
2337              
2338             The standard datetime fields are: B, B, B,
2339             B, and B. If you set B using a B field,
2340             or if you initialize an B object using a B datetime
2341             field, the standard datetime fields are reset to '*' and are invalid.
2342              
2343             The special datetime field is a single field that takes the place of
2344             the 5 standard datetime fields (see L and L).
2345             Currently, if you set B via the B method, the
2346             standard datetime fields (e.g., B, B, etc.) are I
2347             reset; the standard datetime fields are reset to '*' if you set
2348             B via the B method.
2349              
2350             See other important information in the B and B
2351             method descriptions below.
2352              
2353             If the B<-data> attribute is present in the constructor when other
2354             attributes are also present, the B<-data> attribute will override all
2355             other attributes.
2356              
2357             =head2 minute([digits])
2358              
2359             Get or set the minute attribute of the B object.
2360              
2361             Example:
2362              
2363             $event->minute(30);
2364              
2365             print "This event will occur at " . $event->minute . " minutes past the hour\n";
2366              
2367             $event->minute(40);
2368              
2369             print "Now it will occur 10 minutes later\n";
2370              
2371             Note from L:
2372              
2373             Ranges of numbers are allowed. Ranges are two numbers separated with a
2374             hyphen. The specified range is inclusive. For example, 8-11 for an
2375             ``hours'' entry specifies execution at hours 8, 9, 10 and 11.
2376              
2377             Lists are allowed. A list is a set of numbers (or ranges) separated by
2378             commas. Examples: ``1,2,5,9'', ``0-4,8-12''.
2379              
2380             Step values can be used in conjunction with ranges. Following a range
2381             with ``/'' specifies skips of the number's value through the
2382             range. For example, ``0-23/2'' can be used in the hours field to specify
2383             command execution every other hour (the alternative in the V7 standard is
2384             ``0,2,4,6,8,10,12,14,16,18,20,22''). Steps are also permitted after an
2385             asterisk, so if you want to say ``every two hours'', just use ``*/2''.
2386              
2387             =head2 hour([digits])
2388              
2389             Get or set the hour attribute of the B object.
2390              
2391             Example: analogous to B
2392              
2393             Note from L: see B.
2394              
2395             =head2 dom([digits])
2396              
2397             Get or set the day-of-month attribute of the B object.
2398              
2399             Example: analogous to B
2400              
2401             Note from L:
2402              
2403             Note: The day of a command's execution can be specified by two fields --
2404             day of month, and day of week. If both fields are restricted (ie, aren't
2405             *), the command will be run when either field matches the current time.
2406             For example,
2407             ``30 4 1,15 * 5'' would cause a command to be run at 4:30 am on the 1st
2408             and 15th of each month, plus every Friday.
2409              
2410             =head2 month([string])
2411              
2412             Get or set the month. This may be a digit (1-12) or a three character
2413             English abbreviated month string (Jan, Feb, etc.).
2414              
2415             Note from L:
2416              
2417             Names can also be used for the ``month'' and ``day of week'' fields. Use
2418             the first three letters of the particular day or month (case doesn't mat-
2419             ter). Ranges or lists of names are not allowed.
2420              
2421             =head2 dow([string])
2422              
2423             Get or set the day of week.
2424              
2425             Example: analogous to B
2426              
2427             Note from L: see the B entry above.
2428              
2429             =head2 special([string])
2430              
2431             Get or set the special datetime field.
2432              
2433             The special datetime field is one of (from L):
2434              
2435             string meaning
2436             ------ -------
2437             @reboot Run once, at startup.
2438             @yearly Run once a year, "0 0 1 1 *".
2439             @annually (sames as @yearly)
2440             @monthly Run once a month, "0 0 1 * *".
2441             @weekly Run once a week, "0 0 * * 0".
2442             @daily Run once a day, "0 0 * * *".
2443             @midnight (same as @daily)
2444             @hourly Run once an hour, "0 * * * *".
2445              
2446             If you set a datetime via B, this will override anything in
2447             the other standard datetime fields.
2448              
2449             While you may use a special datetime string as an argument to the
2450             B method, you may I use a standard datetime string in
2451             the B method. Currently there is no error checking on this
2452             field, but behavior is undefined.
2453              
2454             The B method will return the B value in preference
2455             to any other standard datetime fields. That is, if B has a
2456             value (e.g., '@reboot', etc.) it will be returned in all methods that
2457             return aggregate event data (e.g., B, B, B,
2458             etc.). If B is false, the standard datetime fields will be
2459             returned instead. Thus, you should always check the value of
2460             B before using any of the standard datetime fields:
2461              
2462             if( $event->special ) {
2463             print $event->special . "\n";
2464             }
2465              
2466             ## use standard datetime elements
2467             else {
2468             print $event->minute . " " . $event->hour ...
2469             }
2470              
2471             If you're presenting the entire datetime field formatted, use the
2472             B method (and then you don't have to do any checks on
2473             B):
2474              
2475             ## will print the special datetime value if set,
2476             ## standard datetime fields otherwise
2477             print $event->datetime . "\n";
2478              
2479             =head2 data([string])
2480              
2481             Get or set the raw event line.
2482              
2483             Internally, this is how the main B class does its
2484             parsing: it iterates over the crontab file and hands each line off to
2485             the B method for further parsing.
2486              
2487             Example:
2488              
2489             $event->data("#0 2 * * * /bin/foo");
2490              
2491             ## prints "inactive (/bin/foo): 0 2 * * *";
2492             print ( $event->active ? '' : 'in' ) . 'active '
2493             . '(' . $event->command . '): "
2494             . $event->datetime;
2495              
2496             =head2 datetime([string])
2497              
2498             Get or set the datetime fields of an event.
2499              
2500             Possible datetime fields are either a special datetime format (e.g.,
2501             @daily, @weekly, etc) B a standard datetime format (e.g., "0 2 *
2502             * Mon" is standard).
2503              
2504             B is often a convenient shortcut for parsing a datetime
2505             field if you're not precisely sure what's in it (but are sure that
2506             it's either a special datetime field or a standard datetime field):
2507              
2508             $event->datetime($some_string);
2509              
2510             While you may pass a special datetime field into B, you may
2511             B pass a standard field into the B method. Currently,
2512             the object will not complain, and may even work in most cases, but the
2513             behavior is undefined and will likely become more strict in the
2514             future.
2515              
2516             =head2 user([string])
2517              
2518             Get or set the user part of a I B object.
2519              
2520             Example:
2521              
2522             $event->user('joeuser');
2523              
2524             The B field is only accessible when the crontab object was
2525             created or parsed with B mode enabled (see L
2526             above).
2527              
2528             =head2 system([boolean])
2529              
2530             When set, will parse a B<-data> string looking for a username before
2531             the command as described in L.
2532              
2533             Example:
2534              
2535             $event->system(1);
2536             $event->data('0 2 * * * joeuser /bin/foo --args');
2537              
2538             This will set the user as 'joeuser' and the command as '/bin/foo
2539             --args'. Notice that if you pass bad data, the B parser really
2540             can't help since the I (including '/Elogin-classE')
2541             syntax is now supported as of version 1.05:
2542              
2543             $event = new Config::Crontab::Event( -data => '2 5 * * * /bin/foo --args',
2544             -system => 1 );
2545              
2546             The B object will have '/bin/foo' as its user and '--args' as
2547             its command. While things will usually work out when you write to
2548             file, you definitely won't get what you're expecting if you grok the
2549             I field.
2550              
2551             =head2 command([string])
2552              
2553             Get or set the command part of a B object.
2554              
2555             Example:
2556              
2557             $event->command('/bin/foo with args here');
2558              
2559             =head2 active([boolean])
2560              
2561             Get or set whether the B object is active. In practical terms,
2562             this simply inserts a pound sign before the datetime fields when
2563             accessing the B method. It is only used implicitly in B,
2564             but may be accessed separately whenever convenient.
2565              
2566             print ( $event->active ? '' : '#' ) . $event->data . "\n";
2567              
2568             is the same as:
2569              
2570             print $event->dump . "\n";
2571              
2572             =head2 dump
2573              
2574             Returns a formatted string of the B object. This method is
2575             called implicitly when flushing to disk in B. It is
2576             not newline terminated.
2577              
2578             Example:
2579              
2580             print $event->dump . "\n";
2581              
2582             =cut
2583              
2584             ############################################################
2585             ############################################################
2586              
2587             ## env objects are a few lines of comments followed by a variable assignment
2588             package Config::Crontab::Env;
2589 9     9   42 use strict;
  9         8  
  9         170  
2590 9     9   25 use warnings;
  9         9  
  9         328  
2591              
2592             our @ISA = qw(Config::Crontab::Base);
2593              
2594 9     9   29 use constant RE_ACTIVE => '^\s*(\#*)\s*';
  9         9  
  9         410  
2595 9     9   34 use constant RE_VAR => q!(["']?[^=]+?['"]?)\s*=\s*(.*)$!;
  9         10  
  9         385  
2596 9     9   29 use constant RE_VARIABLE => RE_ACTIVE . RE_VAR;
  9         13  
  9         2975  
2597              
2598             sub init {
2599 285     285   217 my $self = shift;
2600 285         426 my %args = @_;
2601              
2602 285         354 $self->active(1);
2603              
2604 285 100       450 $self->active($args{'-active'}) if defined $args{'-active'};
2605 285 100       406 $self->name($args{'-name'}) if $args{'-name'};
2606 285 100       360 $self->value($args{'-value'}) if defined $args{'-value'};
2607              
2608 285         246 my $rv = 1;
2609 285 100       378 if( defined $args{'-data'} ) {
2610 274         352 $rv = $self->data($args{'-data'});
2611             }
2612              
2613 285 100       485 return ( defined $rv ? 1 : undef );
2614             }
2615              
2616             sub data {
2617 501     501   372 my $self = shift;
2618 501         374 my $data = '';
2619              
2620 501 100       671 if( @_ ) {
2621 276         204 $data = shift;
2622 276 100       346 $data = '' unless $data; ## normalize false values
2623              
2624 276         277 my @matches = ();
2625 276 100       821 if( @matches = $data =~ RE_VARIABLE ) {
2626 69         89 my $active = shift @matches;
2627 69 100       150 $self->active( ($active ? 0 : 1) );
2628 69         136 $self->name( shift @matches );
2629 69         121 $self->value( shift @matches );
2630             }
2631              
2632             ## not a valid Env object
2633             else {
2634 207         254 return;
2635             }
2636             }
2637              
2638 294 100       340 return ( $self->name
2639             ? $self->name . '=' . $self->value
2640             : $self->name );
2641             }
2642              
2643             sub inactive {
2644 0     0   0 my $self = shift;
2645 0 0       0 return ( $self->active ? 0 : 1 );
2646             }
2647              
2648             sub dump {
2649 207     207   199 my $self = shift;
2650 207         173 my $ret = '';
2651            
2652 207 100       253 if( $self->name ) {
2653 201 100       237 $ret .= ( $self->active
2654             ? ''
2655             : '#' );
2656             }
2657              
2658 207         271 $ret .= $self->data;
2659             }
2660              
2661             ############################################################
2662             ############################################################
2663              
2664             =head1 PACKAGE Config::Crontab::Env
2665              
2666             This section describes B objects (hereafter
2667             B objects). A B object is an abstracted way of dealing with
2668             crontab lines that look like any of the following (see L):
2669              
2670             name = value
2671              
2672             From L:
2673              
2674             the spaces around the equal-sign (=) are optional, and any
2675             subsequent non-leading spaces in value will be part of the value
2676             assigned to name. The value string may be placed in quotes
2677             (single or double, but matching) to preserve leading or trailing
2678             blanks. The name string may also be placed in quote (single or
2679             double, but matching) to preserve leading, traling or inner
2680             blanks.
2681              
2682             Like B objects, B objects may be I or I,
2683             the difference being an I B object is commented out:
2684              
2685             #FOO=bar
2686              
2687             =head2 Terminology
2688              
2689             Given the following crontab environment line:
2690              
2691             MAILTO=joe
2692              
2693             we define the following parts of the B object:
2694              
2695             MAILTO = joe
2696             ====== ============ =====
2697             name (not stored) value
2698              
2699             These and other methods for accessing and manipulating B
2700             objects are described in subsequent sections.
2701              
2702             =head1 METHODS
2703              
2704             =head2 new([%args])
2705              
2706             Creates a new B object. You may create B objects any of the
2707             following ways:
2708              
2709             =over 4
2710              
2711             =item Empty
2712              
2713             $env = new Config::Crontab::Env;
2714              
2715             =item Partially Populated
2716              
2717             $env = new Config::Crontab::Env( -value => 'joe' );
2718              
2719             =item Fully Populated
2720              
2721             $env = new Config::Crontab::Env( -name => 'FOO',
2722             -value => 'blech' );
2723              
2724             =back
2725              
2726             Constructor attributes available in the B method take the same
2727             arguments as their method counterparts (described below), except that
2728             the names of the attributes must have a hyphen ('-') prepended to the
2729             attribute name (e.g., 'value' becomes '-value'). The following is a
2730             list of attributes available to the B method:
2731              
2732             =over 4
2733              
2734             =item B<-name>
2735              
2736             =item B<-value>
2737              
2738             =item B<-data>
2739              
2740             =item B<-active>
2741              
2742             =back
2743              
2744             Each of these attributes corresponds directly to its similarly-named
2745             method.
2746              
2747             Examples:
2748              
2749             ## use name and value
2750             $env = new Config::Crontab::Env( -name => 'MAILTO',
2751             -value => 'joe@schmoe.org' );
2752              
2753             ## parse a whole string
2754             $env = new Config::Crontab::Env( -data => 'MAILTO=joe@schmoe.org' );
2755              
2756             ## use name and value to create an inactive object
2757             $env = new Config::Crontab::Env( -active => 0,
2758             -name => 'MAILTO',
2759             -value => 'mike', );
2760             $env->active(1); ## now activate it
2761              
2762             ## create an object that will unset the environment variable
2763             $env = new Config::Crontab::Env( -name => 'MAILTO' );
2764              
2765             ## another way
2766             $env = new Config::Crontab::Env( -data => 'MAILTO=' );
2767              
2768             ## yet another way
2769             $env = new Config::Crontab::Env;
2770             $env->name('MAILTO');
2771              
2772             If bogus data is passed to the constructor, it will return I
2773             instead of an object reference. If there is a possiblility of poorly
2774             formatted data going into the constructor, you should check the object
2775             variable for definedness before using it.
2776              
2777             If the B<-data> attribute is present in the constructor when other
2778             attributes are also present, the B<-data> attribute will override all
2779             other attributes.
2780              
2781             =head2 name([string])
2782              
2783             Get or set the object name.
2784              
2785             Example:
2786              
2787             $env->name('MAILTO');
2788              
2789             =head2 value([string])
2790              
2791             Get or set the value associated with the name attribute.
2792              
2793             Example:
2794              
2795             $env->value('tom@tomorrow.org');
2796              
2797             print "The value for " . $env->name . " is " . $env->value . "\n";
2798              
2799             =head2 data([string])
2800              
2801             Get or set a raw environment line.
2802              
2803             Example:
2804              
2805             $env->data('MAILTO=foo@bar.org');
2806              
2807             print "This object says: " . $env->data . "\n";
2808              
2809             =head2 active([boolean])
2810              
2811             Get or set whether the B object is active. In practical terms,
2812             this simply inserts a pound sign before the B field when
2813             accessing the B method. It may be used whenever convenient.
2814              
2815             print $env->dump . "\n";
2816              
2817             is the same as:
2818              
2819             print ( $env->active ? '' : '#' ) . $env->data . "\n";
2820              
2821             =head2 dump
2822              
2823             Returns a formatted string of the B object. This method is called
2824             implicitly when flushing to disk in B. It is not
2825             newline terminated.
2826              
2827             print $env->dump . "\n";
2828              
2829             =cut
2830              
2831             ############################################################
2832             ############################################################
2833              
2834             ## comment objects are empty lines (lines containing only whitespace)
2835             ## or lines beginning with # and which do not match an event or
2836             ## environment pattern
2837             package Config::Crontab::Comment;
2838 9     9   35 use strict;
  9         7  
  9         144  
2839 9     9   23 use warnings;
  9         7  
  9         1971  
2840              
2841             our @ISA = qw(Config::Crontab::Base);
2842              
2843             sub init {
2844 228     228   178 my $self = shift;
2845 228 100       488 my %args = ( @_ == 1 ? ('-data' => @_) : @_ );
2846 228         184 my $data = '';
2847              
2848 228 100       297 if( exists $args{'-data'} ) {
    50          
2849 223         194 $data = $args{'-data'};
2850             }
2851              
2852             ## no '-data' tag, just the data
2853             elsif( @_ ) {
2854 0         0 $data = shift;
2855             }
2856              
2857 228 100       364 chomp $data if $data;
2858              
2859 228         282 my $rv = $self->data($data);
2860              
2861 228 100       414 return ( defined $rv ? 1 : undef );
2862             }
2863              
2864             sub data {
2865 874     874   690 my $self = shift;
2866 874         618 my $data = '';
2867              
2868 874 100       1178 if( @_ ) {
2869 229         171 $data = shift;
2870 229 100       309 $data = '' unless $data; ## normalize false values
2871              
2872 229 100 100     1230 unless( $data =~ /^\s*$/ || $data =~ /^\s*\#/ ) {
2873 1         2 return;
2874             }
2875              
2876 228         399 $self->{'_data'} = $data;
2877             }
2878              
2879 873 50       2187 return ( defined $self->{'_data'} ? $self->{'_data'} : $data );
2880             }
2881              
2882             ############################################################
2883             ############################################################
2884              
2885             =head1 PACKAGE Config::Crontab::Comment
2886              
2887             This section describes B objects (hereafter
2888             B objects). A B object is an abstracted way of
2889             dealing with crontab comments and whitespace (blank lines or lines
2890             that consist only of whitespace).
2891              
2892             =head1 METHODS
2893              
2894             =head2 new([%args])
2895              
2896             Creates a new B object. You may create B objects in
2897             any of the following ways:
2898              
2899             =over 4
2900              
2901             =item Empty
2902              
2903             $comment = new Config::Crontab::Comment;
2904              
2905             =item Populated
2906              
2907             $comment = new Config::Crontab::Comment( -data => '# this is a comment' );
2908              
2909             and an alternative:
2910              
2911             $comment = new Config::Crontab::Comment( '# this is a constructor shortcut' );
2912              
2913             =back
2914              
2915             Constructor attributes available in the B method take the same
2916             arguments as their method counterparts (described below), except that
2917             the names of the attributes must have a hyphen ('-') prepended to the
2918             attribute name (e.g., 'data' becomes '-data'). The following is a list
2919             of attributes available to the B method:
2920              
2921             =over 4
2922              
2923             =item B<-data>
2924              
2925             =back
2926              
2927             Each of these attributes corresponds directly to its similarly-named
2928             method.
2929              
2930             Examples:
2931              
2932             ## using data
2933             $comment = new Config::Crontab::Comment( -data => '## a nice comment' );
2934              
2935             ## using data method
2936             $comment = new Config::Crontab::Comment;
2937             $comment->data('## hi Mom!');
2938              
2939             If bogus data is passed to the constructor, it will return I
2940             instead of an object reference. If there is a possiblility of poorly
2941             formatted data going into the constructor, you should check the object
2942             variable for definedness before using it.
2943              
2944             As a shortcut, you may omit the B<-data> label and simply pass the
2945             comment itself:
2946              
2947             $comment = new Config::Crontab::Comment('## this space for rent or lease');
2948              
2949             =head2 data([string])
2950              
2951             Get or set a comment.
2952              
2953             Example:
2954              
2955             $comment->data('## this is not the comment you are looking for');
2956              
2957             =head2 dump
2958              
2959             Returns a formatted string of the B object. This method is
2960             called implicitly when flushing to disk in B. It is
2961             not newline terminated.
2962              
2963             =cut
2964              
2965             ############################################################
2966             ############################################################
2967              
2968             ## a virtual base class for top-level container classes
2969             package Config::Crontab::Container;
2970 9     9   34 use strict;
  9         13  
  9         149  
2971 9     9   27 use warnings;
  9         11  
  9         191  
2972 9     9   28 use Carp;
  9         12  
  9         4771  
2973              
2974             sub up {
2975 3     3   73 my $self = shift;
2976 3         5 my $targ = shift;
2977              
2978 3 50       8 return unless ref($targ);
2979              
2980 3         7 my @objs = $self->elements;
2981              
2982 3         5 my $found;
2983 3         10 for my $i ( 0..$#objs ) {
2984 12 100       23 if( $objs[$i] == $targ ) {
2985 3 100       11 ($objs[$i], $objs[$i-1]) = ($objs[$i-1], $objs[$i]) ## swap...
2986             unless $i == 0; ## unless already first
2987 3         3 $found = 1;
2988 3         4 last;
2989             }
2990             }
2991              
2992 3 50       6 unshift @objs, $targ unless $found;
2993 3         6 $self->elements( \@objs );
2994             }
2995              
2996             sub down {
2997 6     6   11 my $self = shift;
2998 6         4 my $targ = shift;
2999              
3000 6 50       17 return unless ref($targ);
3001              
3002 6         13 my @objs = $self->elements;
3003              
3004 6         7 my $found;
3005 6         19 for my $i ( 0..$#objs ) {
3006 14 100       32 if( $objs[$i] == $targ ) {
3007 5 100       24 ($objs[$i], $objs[$i+1]) = ($objs[$i+1], $objs[$i]) ## swap...
3008             unless $i == $#objs; ## unless already last
3009 5         10 $found = 1;
3010 5         8 last;
3011             }
3012             }
3013              
3014 6 100       14 push @objs, $targ unless $found;
3015 6         13 $self->elements( \@objs );
3016             }
3017              
3018             sub first {
3019 7     7   15 my $self = shift;
3020 7         10 my @targ = grep { ref($_) } @_;
  10         21  
3021              
3022 7         12 $self->remove(@targ);
3023 7         18 $self->elements( [@targ, $self->elements] );
3024             }
3025              
3026             sub last {
3027 733     733   571 my $self = shift;
3028 733         755 my @targ = grep { ref($_) } @_;
  739         1180  
3029              
3030 733         957 $self->remove(@targ);
3031 733         840 $self->elements( [$self->elements, @targ] );
3032             }
3033              
3034             sub before {
3035 2     2   9 my $self = shift;
3036 2         2 my $ref = shift;
3037 2         3 my @targ = @_;
3038              
3039 2         3 $self->remove(@targ);
3040              
3041 2         2 my @objs = ();
3042 2         2 my $found = 0;
3043 2         2 for my $obj ( $self->elements ) {
3044 7 100 100     21 if( ! $found && $ref && ($obj == $ref) ) {
      66        
3045 1         1 push @objs, @targ;
3046 1         1 $found = 1;
3047             }
3048 7         6 push @objs, $obj;
3049             }
3050              
3051 2 100       3 unshift @objs, @targ unless $found;
3052              
3053 2         3 $self->elements(\@objs);
3054             }
3055              
3056             sub after {
3057 2     2   5 my $self = shift;
3058 2         3 my $ref = shift;
3059 2         4 my @targ = @_;
3060              
3061 2         6 $self->remove(@targ);
3062              
3063 2         3 my @objs = ();
3064 2         4 my $found = 0;
3065 2         4 for my $obj ( $self->elements ) {
3066 9         10 push @objs, $obj;
3067 9 100 66     21 if( ! $found && ($obj == $ref) ) {
3068 2         4 push @objs, @targ;
3069 2         3 $found = 1;
3070             }
3071             }
3072              
3073 2 50       6 push @objs, @targ unless $found;
3074              
3075 2         5 $self->elements(\@objs);
3076             }
3077              
3078             sub replace {
3079 2     2   15 my $self = shift;
3080 2         24 my $old = shift;
3081 2         5 my $new = shift;
3082              
3083 2 50 33     19 return unless ref($old) && ref($new);
3084              
3085 2         9 my @objs = $self->elements;
3086 2         6 my $found;
3087 2         8 for my $i ( 0..$#objs ) {
3088 7 100       16 if( $objs[$i] == $old ) {
3089 2         4 $objs[$i] = $new;
3090 2         3 $found = 1;
3091 2         3 last;
3092             }
3093             }
3094              
3095 2         6 $self->elements( \@objs );
3096 2 50       7 return ( $found ? $old : undef );
3097             }
3098              
3099             ############################################################
3100             ############################################################
3101              
3102             ## the virtual base class of all Config::Crontab classes
3103             package Config::Crontab::Base;
3104 9     9   40 use strict;
  9         10  
  9         144  
3105 9     9   25 use warnings;
  9         7  
  9         173  
3106 9     9   25 use Carp;
  9         9  
  9         2730  
3107              
3108             our $AUTOLOAD;
3109              
3110             sub new {
3111 1311     1311   312178 my $self = { };
3112 1311         1039 my $proto = shift;
3113 1311   33     3252 my $class = ref($proto) || $proto;
3114              
3115 1311         1208 bless $self, $class;
3116              
3117 1311         1821 my $rv = $self->init(@_);
3118 1310         1643 $self->flag('');
3119              
3120 1310 100       3754 return ( $rv ? $self : undef );
3121             }
3122              
3123             ## boolean: if returns false, 'new' will return undef, $self otherwise
3124             sub init {
3125 0     0   0 my $self = shift;
3126 0         0 my %args = @_;
3127              
3128 0         0 return 1;
3129             }
3130              
3131             sub dump {
3132 990     990   733 my $self = shift;
3133 990         1065 return $self->data; ## this will AUTOLOAD if not present
3134             }
3135              
3136             sub flag {
3137 1336     1336   1004 my $self = shift;
3138 1336 100       2263 $self->{'_flag'} = shift if @_;
3139 1336         1113 return $self->{'_flag'};
3140             }
3141              
3142             sub AUTOLOAD {
3143 148 50   148   286 my $self = shift or return;
3144              
3145 148         105 my $sub = $AUTOLOAD;
3146 148         430 $sub =~ s/^.*:://;
3147 148 50       269 return if $sub eq 'DESTROY';
3148              
3149 148         92 my $foni;
3150              
3151             ## new accessor
3152 148 50       306 if( $sub =~ /^(\w+)$/ ) {
3153 148         207 my $subname = $1;
3154             $foni = sub {
3155 27001     27001   17203 my $self = shift;
3156 27001 100       35572 $self->{"_$subname"} = shift if @_;
3157 27001 100       64548 return ( defined $self->{"_$subname"} ? $self->{"_$subname"} : '' );
3158 148         433 };
3159             }
3160              
3161             else {
3162 0         0 croak "Undefined subroutine '$sub'";
3163             }
3164              
3165             ## do magic
3166             SYMBOLS: {
3167 9     9   39 no strict 'refs';
  9         14  
  9         644  
  148         107  
3168 148         316 *$AUTOLOAD = $foni;
3169             }
3170 148         148 unshift @_, $self; ## put me back on call stack
3171 148         265 goto &$AUTOLOAD; ## jump to me
3172             }
3173              
3174             1;
3175             __END__