lib/Catalyst/Plugin/Scheduler.pm

   1 package Catalyst::Plugin::Scheduler;
   2
   3 use strict;
   4 use warnings;
   5 use base qw/Class::Accessor::Fast Class::Data::Inheritable/;
   6 use DateTime;
   7 use DateTime::Event::Cron;
   8 use DateTime::TimeZone;
   9 use File::stat;
  10 use NEXT;
  11 use Set::Scalar;
  12 use Storable qw/lock_store lock_retrieve/;
  13 use YAML;
  14
  15 our $VERSION = '0.06';
  16
  17 __PACKAGE__->mk_classdata( '_events' => [] );
  18 __PACKAGE__->mk_accessors('_event_state');
  19
  20 sub schedule {
  21     my ( $class, %args ) = @_;
  22
  23     unless ( $args{event} ) {
  24         Catalyst::Exception->throw(
  25             message => 'The schedule method requires an event parameter' );
  26     }
  27
  28     my $conf = $class->config->{scheduler};
  29
  30     my $event = {
  31         trigger  => $args{trigger},
  32         event    => $args{event},
  33         auto_run => ( defined $args{auto_run} ) ? $args{auto_run} : 1,
  34     };
  35
  36     if ( $args{at} ) {
  37
  38         # replace keywords that Set::Crontab doesn't support
  39         $args{at} = _prepare_cron( $args{at} );
  40
  41         # parse the cron entry into a DateTime::Set
  42         my $set;
  43         eval { $set = DateTime::Event::Cron->from_cron( $args{at} ) };
  44         if ($@) {
  45             Catalyst::Exception->throw(
  46                       "Scheduler: Unable to parse 'at' value "
  47                     . $args{at} . ': '
  48                     . $@ );
  49         }
  50         else {
  51             $event->{at}  = $args{at};
  52             $event->{set} = $set;
  53         }
  54     }
  55
  56     push @{ $class->_events }, $event;
  57 }
  58
  59 sub dispatch {
  60     my $c = shift;
  61
  62     $c->NEXT::dispatch(@_);
  63
  64     $c->_get_event_state();
  65
  66     $c->_check_yaml();
  67
  68     # check if a minute has passed since our last check
  69     # This check is not run if the user is manually triggering an event
  70     if ( time - $c->_event_state->{last_check} < 60 ) {
  71         return unless $c->req->params->{schedule_trigger};
  72     }
  73     my $last_check = $c->_event_state->{last_check};
  74     $c->_event_state->{last_check} = time;
  75     $c->_save_event_state();
  76
  77     my $conf          = $c->config->{scheduler};
  78     my $last_check_dt = DateTime->from_epoch(
  79         epoch     => $last_check,
  80         time_zone => $conf->{time_zone}
  81     );
  82     my $now = DateTime->now( time_zone => $conf->{time_zone} );
  83
  84     EVENT:
  85     for my $event ( @{ $c->_events } ) {
  86         my $next_run;
  87
  88         if (   $event->{trigger}
  89             && $event->{trigger} eq $c->req->params->{schedule_trigger} )
  90         {
  91
  92             # manual trigger, run it now
  93             next EVENT unless $c->_event_authorized;
  94             $next_run = $now;
  95         }
  96         else {
  97             next EVENT unless $event->{set};
  98             $next_run = $event->{set}->next($last_check_dt);
  99         }
 100
 101         if ( $next_run <= $now ) {
 102
 103             # do some security checking for non-auto-run events
 104             if ( !$event->{auto_run} ) {
 105                 next EVENT unless $c->_event_authorized;
 106             }
 107
 108             # make sure we're the only process running this event
 109             next EVENT unless $c->_mark_running($event);
 110
 111             my $event_name = $event->{trigger} || $event->{event};
 112             $c->log->debug("Scheduler: Executing $event_name")
 113                 if $c->config->{scheduler}->{logging};
 114
 115             # trap errors
 116             local $c->{error} = [];
 117
 118             # return value/output from the event, if any
 119             my $output;
 120
 121             # run event
 122             eval {
 123
 124                 # do not allow the event to modify the response
 125                 local $c->res->{body};
 126                 local $c->res->{cookies};
 127                 local $c->res->{headers};
 128                 local $c->res->{location};
 129                 local $c->res->{status};
 130
 131                 if ( ref $event->{event} eq 'CODE' ) {
 132                     $output = $event->{event}->($c);
 133                 }
 134                 else {
 135                     $output = $c->forward( $event->{event} );
 136                 }
 137             };
 138             my @errors = @{ $c->{error} };
 139             push @errors, $@ if $@;
 140             if (@errors) {
 141                 $c->log->error(
 142                     'Scheduler: Error executing ' . "$event_name: $_" )
 143                     for @errors;
 144                 $output = join '; ', @errors;
 145             }
 146
 147             $c->_mark_finished( $event, $output );
 148         }
 149     }
 150 }
 151
 152 sub setup {
 153     my $c = shift;
 154
 155     # initial configuration
 156     $c->config->{scheduler}->{logging}     ||= ( $c->debug ) ? 1 : 0;
 157     $c->config->{scheduler}->{time_zone}   ||= $c->_detect_timezone();
 158     $c->config->{scheduler}->{state_file}  ||= $c->path_to('scheduler.state');
 159     $c->config->{scheduler}->{hosts_allow} ||= '127.0.0.1';
 160     $c->config->{scheduler}->{yaml_file}   ||= $c->path_to('scheduler.yml');
 161
 162     $c->NEXT::setup(@_);
 163 }
 164
 165 sub dump_these {
 166     my $c = shift;
 167
 168     return ( $c->NEXT::dump_these(@_) ) unless @{ $c->_events };
 169
 170     # for debugging, we dump out a list of all events with their next
 171     # scheduled run time
 172     return (
 173         $c->NEXT::dump_these(@_),
 174         [ 'Scheduled Events', $c->scheduler_state ],
 175     );
 176 }
 177
 178 sub scheduler_state {
 179     my $c = shift;
 180
 181     $c->_get_event_state();
 182
 183     my $conf = $c->config->{scheduler};
 184     my $now  = DateTime->now( time_zone => $conf->{time_zone} );
 185
 186     my $last_check = $c->_event_state->{last_check};
 187     my $last_check_dt = DateTime->from_epoch(
 188         epoch     => $last_check,
 189         time_zone => $conf->{time_zone},
 190     );
 191
 192     my $event_dump = [];
 193     for my $event ( @{ $c->_events } ) {
 194         my $dump = {};
 195         for my $key ( qw/at trigger event auto_run/ ) {
 196             $dump->{$key} = $event->{$key} if $event->{$key};
 197         }
 198
 199         # display the next run time
 200         if ( $event->{set} ) {
 201             my $next_run = $event->{set}->next($last_check_dt);
 202             $dump->{next_run}
 203                 = $next_run->ymd
 204                 . q{ } . $next_run->hms
 205                 . q{ } . $next_run->time_zone_short_name;
 206         }
 207
 208         # display the last run time
 209         my $last_run
 210             = $c->_event_state->{events}->{ $event->{event} }->{last_run};
 211         if ( $last_run ) {
 212             $last_run = DateTime->from_epoch(
 213                 epoch => $last_run,
 214                 time_zone => $conf->{time_zone},
 215             );
 216             $dump->{last_run}
 217                 = $last_run->ymd
 218                 . q{ } . $last_run->hms
 219                 . q{ } . $last_run->time_zone_short_name;
 220         }
 221
 222         # display the result of the last run
 223         my $output
 224             = $c->_event_state->{events}->{ $event->{event} }->{last_output};
 225         if ( $output ) {
 226             $dump->{last_output} = $output;
 227         }
 228
 229         push @{$event_dump}, $dump;
 230     }
 231
 232     return $event_dump;
 233 }
 234
 235 # check and reload the YAML file with schedule data
 236 sub _check_yaml {
 237     my ($c) = @_;
 238
 239     # each process needs to load the YAML file independently
 240     if ( $c->_event_state->{yaml_mtime}->{$$} ||= 0 ) {
 241         return if ( time - $c->_event_state->{last_check} < 60 );
 242     }
 243
 244     return unless -e $c->config->{scheduler}->{yaml_file};
 245
 246     eval {
 247         my $mtime = ( stat $c->config->{scheduler}->{yaml_file} )->mtime;
 248         if ( $mtime > $c->_event_state->{yaml_mtime}->{$$} ) {
 249             $c->_event_state->{yaml_mtime}->{$$} = $mtime;
 250
 251             # clean up old PID files listed in yaml_mtime
 252             foreach my $pid ( keys %{ $c->_event_state->{yaml_mtime} } ) {
 253                 if ( $c->_event_state->{yaml_mtime}->{$pid} < $mtime ) {
 254                     delete $c->_event_state->{yaml_mtime}->{$pid};
 255                 }
 256             }
 257             $c->_save_event_state();
 258
 259             # wipe out all current events and reload from YAML
 260             $c->_events( [] );
 261
 262             my $yaml = YAML::LoadFile( $c->config->{scheduler}->{yaml_file} );
 263
 264             foreach my $event ( @{$yaml} ) {
 265                 $c->schedule( %{$event} );
 266             }
 267
 268             $c->log->info( "Scheduler: PID $$ loaded "
 269                     . scalar @{$yaml}
 270                     . ' events from YAML file' )
 271                 if $c->config->{scheduler}->{logging};
 272         }
 273     };
 274     if ($@) {
 275         $c->log->error("Scheduler: Error reading YAML file: $@");
 276     }
 277 }
 278
 279 # Detect the current time zone
 280 sub _detect_timezone {
 281     my $c = shift;
 282
 283     my $tz;
 284     eval { $tz = DateTime::TimeZone->new( name => 'local' ) };
 285     if ($@) {
 286         $c->log->warn(
 287             'Scheduler: Unable to autodetect local time zone, using UTC')
 288             if $c->config->{scheduler}->{logging};
 289         return 'UTC';
 290     }
 291     else {
 292         $c->log->debug(
 293             'Scheduler: Using autodetected time zone: ' . $tz->name )
 294             if $c->config->{scheduler}->{logging};
 295         return $tz->name;
 296     }
 297 }
 298
 299 # Check for authorized users on non-auto events
 300 sub _event_authorized {
 301     my $c = shift;
 302
 303     # this should never happen, but just in case...
 304     return unless $c->req->address;
 305
 306     my $hosts_allow = $c->config->{scheduler}->{hosts_allow};
 307     $hosts_allow = [$hosts_allow] unless ref($hosts_allow) eq 'ARRAY';
 308     my $allowed = Set::Scalar->new( @{$hosts_allow} );
 309     return $allowed->contains( $c->req->address );
 310 }
 311
 312 # get the state from the state file
 313 sub _get_event_state {
 314     my $c = shift;
 315
 316     if ( -e $c->config->{scheduler}->{state_file} ) {
 317         $c->_event_state(
 318             lock_retrieve $c->config->{scheduler}->{state_file} );
 319     }
 320     else {
 321
 322         # initialize the state file
 323         $c->_event_state(
 324             {   last_check  => time,
 325                 events      => {},
 326                 yaml_mtime  => {},
 327             }
 328         );
 329         $c->_save_event_state();
 330     }
 331 }
 332
 333 # Check the state file to ensure we are the only process running an event
 334 sub _mark_running {
 335     my ( $c, $event ) = @_;
 336
 337     $c->_get_event_state();
 338
 339     return if
 340         $c->_event_state->{events}->{ $event->{event} }->{running};
 341
 342     # this is a 2-step process to prevent race conditions
 343     # 1. write the state file with our PID
 344     $c->_event_state->{events}->{ $event->{event} }->{running} = $$;
 345     $c->_save_event_state();
 346
 347     # 2. re-read the state file and make sure it's got the same PID
 348     $c->_get_event_state();
 349     if ( $c->_event_state->{events}->{ $event->{event} }->{running} == $$ ) {
 350         return 1;
 351     }
 352
 353     return;
 354 }
 355
 356 # Mark an event as finished
 357 sub _mark_finished {
 358     my ( $c, $event, $output ) = @_;
 359
 360     $c->_event_state->{events}->{ $event->{event} }->{running}     = 0;
 361     $c->_event_state->{events}->{ $event->{event} }->{last_run}    = time;
 362     $c->_event_state->{events}->{ $event->{event} }->{last_output} = $output;
 363     $c->_save_event_state();
 364 }
 365
 366 # update the state file on disk
 367 sub _save_event_state {
 368     my $c = shift;
 369
 370     lock_store $c->_event_state, $c->config->{scheduler}->{state_file};
 371 }
 372
 373 # Set::Crontab does not support day names, or '@' shortcuts
 374 sub _prepare_cron {
 375     my $cron = shift;
 376
 377     return $cron unless $cron =~ /\w/;
 378
 379     my %replace = (
 380         jan   => 1,
 381         feb   => 2,
 382         mar   => 3,
 383         apr   => 4,
 384         may   => 5,
 385         jun   => 6,
 386         jul   => 7,
 387         aug   => 8,
 388         sep   => 9,
 389         'oct' => 10,
 390         nov   => 11,
 391         dec   => 12,
 392
 393         sun => 0,
 394         mon => 1,
 395         tue => 2,
 396         wed => 3,
 397         thu => 4,
 398         fri => 5,
 399         sat => 6,
 400     );
 401
 402     my %replace_at = (
 403         'yearly'   => '0 0 1 1 *',
 404         'annually' => '0 0 1 1 *',
 405         'monthly'  => '0 0 1 * *',
 406         'weekly'   => '0 0 * * 0',
 407         'daily'    => '0 0 * * *',
 408         'midnight' => '0 0 * * *',
 409         'hourly'   => '0 * * * *',
 410     );
 411
 412     if ( $cron =~ /^\@/ ) {
 413         $cron =~ s/^\@//;
 414         return $replace_at{ $cron };
 415     }
 416
 417     for my $name ( keys %replace ) {
 418         my $value = $replace{$name};
 419         $cron =~ s/$name/$value/i;
 420         last unless $cron =~ /\w/;
 421     }
 422     return $cron;
 423 }
 424
 425 1;
 426 __END__
 427
 428 =pod
 429
 430 =head1 NAME
 431
 432 Catalyst::Plugin::Scheduler - Schedule events to run in a cron-like fashion
 433
 434 =head1 SYNOPSIS
 435
 436     use Catalyst qw/Scheduler/;
 437
 438     # run remove_sessions in the Cron controller every hour
 439     __PACKAGE__->schedule(
 440         at    => '0 * * * *',
 441         event => '/cron/remove_sessions'
 442     );
 443
 444     # Run a subroutine at 4:05am every Sunday
 445     __PACKAGE__->schedule(
 446         at    => '5 4 * * sun',
 447         event => \&do_stuff,
 448     );
 449
 450     # A long-running scheduled event that must be triggered
 451     # manually by an authorized user
 452     __PACKAGE__->schedule(
 453         trigger => 'rebuild_search_index',
 454         event   => '/cron/rebuild_search_index',
 455     );
 456     $ wget -q http://www.myapp.com/?schedule_trigger=rebuild_search_index
 457
 458 =head1 DESCRIPTION
 459
 460 This plugin allows you to schedule events to run at recurring intervals.
 461 Events will run during the first request which meets or exceeds the specified
 462 time.  Depending on the level of traffic to the application, events may or may
 463 not run at exactly the correct time, but it should be enough to satisfy many
 464 basic scheduling needs.
 465
 466 =head1 CONFIGURATION
 467
 468 Configuration is optional and is specified in MyApp->config->{scheduler}.
 469
 470 =head2 logging
 471
 472 Set to 1 to enable logging of events as they are executed.  This option is
 473 enabled by default when running under -Debug mode.  Errors are always logged
 474 regardless of the value of this option.
 475
 476 =head2 time_zone
 477
 478 The time zone of your system.  This will be autodetected where possible, or
 479 will default to UTC (GMT).  You can override the detection by providing a
 480 valid L<DateTime> time zone string, such as 'America/New_York'.
 481
 482 =head2 state_file
 483
 484 The current state of every event is stored in a file.  By default this is
 485 $APP_HOME/scheduler.state.  This file is created on the first request if it
 486 does not already exist.
 487
 488 =head2 yaml_file
 489
 490 The location of the optional YAML event configuration file.  By default this
 491 is $APP_HOME/scheduler.yml.
 492
 493 =head2 hosts_allow
 494
 495 This option specifies IP addresses for trusted users.  This option defaults
 496 to 127.0.0.1.  Multiple addresses can be specified by using an array
 497 reference.  This option is used for both events where auto_run is set to 0
 498 and for manually-triggered events.
 499
 500     __PACKAGE__->config->{scheduler}->{hosts_allow} = '192.168.1.1';
 501     __PACKAGE__->config->{scheduler}->{hosts_allow} = [
 502         '127.0.0.1',
 503         '192.168.1.1'
 504     ];
 505
 506 =head1 SCHEDULING
 507
 508 =head2 AUTOMATED EVENTS
 509
 510 Events are scheduled by calling the class method C<schedule>.
 511
 512     MyApp->schedule(
 513         at       => '0 * * * *',
 514         event    => '/cron/remove_sessions',
 515     );
 516
 517     package MyApp::Controller::Cron;
 518
 519     sub remove_sessions : Private {
 520         my ( $self, $c ) = @_;
 521
 522         $c->delete_expired_sessions;
 523     }
 524
 525 =head3 at
 526
 527 The time to run an event is specified using L<crontab(5)>-style syntax.
 528
 529     5 0 * * *      # 5 minutes after midnight, every day
 530     15 14 1 * *    # run at 2:15pm on the first of every month
 531     0 22 * * 1-5   # run at 10 pm on weekdays
 532     5 4 * * sun    # run at 4:05am every Sunday
 533
 534 From crontab(5):
 535
 536     field          allowed values
 537     -----          --------------
 538     minute         0-59
 539     hour           0-23
 540     day of month   1-31
 541     month          0-12 (or names, see below)
 542     day of week    0-7 (0 or 7 is Sun, or use names)
 543
 544 Instead of the first five fields, one of seven special strings may appear:
 545
 546     string         meaning
 547     ------         -------
 548     @yearly        Run once a year, "0 0 1 1 *".
 549     @annually      (same as @yearly)
 550     @monthly       Run once a month, "0 0 1 * *".
 551     @weekly        Run once a week, "0 0 * * 0".
 552     @daily         Run once a day, "0 0 * * *".
 553     @midnight      (same as @daily)
 554     @hourly        Run once an hour, "0 * * * *".
 555
 556 =head3 event
 557
 558 The event to run at the specified time can be either a Catalyst private
 559 action path or a coderef.  Both types of event methods will receive the $c
 560 object from the current request, but you must not rely on any request-specific
 561 information present in $c as it will be from a random user request at or near
 562 the event's specified run time.
 563
 564 Important: Methods used for events should be marked C<Private> so that
 565 they can not be executed via the browser.
 566
 567 =head3 auto_run
 568
 569 The auto_run parameter specifies when the event is allowed to be executed.
 570 By default this option is set to 1, so the event will be executed during the
 571 first request that matches the specified time in C<at>.
 572
 573 If set to 0, the event will only run when a request is made by a user from
 574 an authorized address.  The purpose of this option is to allow long-running
 575 tasks to execute only for certain users.
 576
 577     MyApp->schedule(
 578         at       => '0 0 * * *',
 579         event    => '/cron/rebuild_search_index',
 580         auto_run => 0,
 581     );
 582
 583     package MyApp::Controller::Cron;
 584
 585     sub rebuild_search_index : Private {
 586         my ( $self, $c ) = @_;
 587
 588         # rebuild the search index, this may take a long time
 589     }
 590
 591 Now, the search index will only be rebuilt when a request is made from a user
 592 whose IP address matches the list in the C<hosts_allow> config option.  To
 593 run this event, you probably want to ping the app from a cron job.
 594
 595     0 0 * * * wget -q http://www.myapp.com/
 596
 597 =head2 MANUAL EVENTS
 598
 599 To create an event that does not run on a set schedule and must be manually
 600 triggered, you can specify the C<trigger> option instead of C<at>.
 601
 602     __PACKAGE__->schedule(
 603         trigger => 'send_email',
 604         event   => '/events/send_email',
 605     );
 606
 607 The event may then be triggered by a standard web request from an authorized
 608 user.  The trigger to run is specified by using a special GET parameter,
 609 'schedule_trigger'; the path requested does not matter.
 610
 611     http://www.myapp.com/?schedule_trigger=send_email
 612
 613 By default, manual events may only be triggered by requests made from
 614 localhost (127.0.0.1).  To allow other addresses to run events, use the
 615 configuration option L</hosts_allow>.
 616
 617 =head1 SCHEDULING USING A YAML FILE
 618
 619 As an alternative to using the schedule() method, you may define scheduled
 620 events in an external YAML file.  By default, the plugin looks for the
 621 existence of a file called C<schedule.yml> in your application's home
 622 directory.  You can change the filename using the configuration option
 623 L</yaml_file>.
 624
 625 Modifications to this file will be re-read once per minute during the normal
 626 event checking process.
 627
 628 Here's an example YAML configuration file with 4 events.  Each event is
 629 denoted with a '-' character, followed by the same parameters used by the
 630 C<schedule> method.  Note that coderef events are not supported by the YAML
 631 file.
 632
 633     ---
 634     - at: '* * * * *'
 635       event: /cron/delete_sessions
 636     - event: /cron/send_email
 637       trigger: send_email
 638     - at: '@hourly'
 639       event: /cron/hourly
 640     - at: 0 0 * * *
 641       auto_run: 0
 642       event: /cron/rebuild_search_index
 643
 644 =head1 SECURITY
 645
 646 All events are run inside of an eval container.  This protects the user from
 647 receiving any error messages or page crashes if an event fails to run
 648 properly.  All event errors are logged, even if logging is disabled.
 649
 650 =head1 PLUGIN SUPPORT
 651
 652 Other plugins may register scheduled events if they need to perform periodic
 653 maintenance.  Plugin authors, B<be sure to inform your users> if you do this!
 654 Events should be registered from a plugin's C<setup> method.
 655
 656     sub setup {
 657         my $c = shift;
 658         $c->NEXT::setup(@_);
 659
 660         if ( $c->can('schedule') ) {
 661             $c->schedule(
 662                 at    => '0 * * * *',
 663                 event => \&cleanup,
 664             );
 665         }
 666     }
 667
 668 =head1 CAVEATS
 669
 670 The time at which an event will run is determined completely by the requests
 671 made to the application.  Apps with heavy traffic may have events run at very
 672 close to the correct time, whereas apps with low levels of traffic may see
 673 events running much later than scheduled.  If this is a problem, you can use
 674 a real cron entry that simply hits your application at the desired time.
 675
 676     0 * * * * wget -q http://www.myapp.com/
 677
 678 Events which consume a lot of time will slow the request processing for the
 679 user who triggers the event.  For these types of events, you should use
 680 auto_run => 0 or manual event triggering.
 681
 682 =head1 PERFORMANCE
 683
 684 The plugin only checks once per minute if any events need to be run, so the
 685 overhead on each request is minimal.  On my test server, the difference
 686 between running with Scheduler and without was only around 0.02% (0.004
 687 seconds).
 688
 689 Of course, when a scheduled event runs, performance will depend on what's
 690 being run in the event.
 691
 692 =head1 METHODS
 693
 694 =head2 schedule
 695
 696 Schedule is a class method for adding scheduled events.  See the
 697 L<"/SCHEDULING"> section for more information.
 698
 699 =head2 scheduler_state
 700
 701 The current state of all scheduled events is available in an easy-to-use
 702 format by calling $c->scheduler_state.  You can use this data to build an
 703 admin view into the scheduling engine, for example.  This same data is also
 704 displayed on the Catalyst debug screen.
 705
 706 This method returns an array reference containing a hash reference for each
 707 event.
 708
 709     [
 710         {
 711             'last_run'    => '2005-12-29 16:29:33 EST',
 712             'auto_run'    => 1,
 713             'last_output' => 1,
 714             'at'          => '0 0 * * *',
 715             'next_run'    => '2005-12-30 00:00:00 EST',
 716             'event'       => '/cron/session_cleanup'
 717         },
 718         {
 719             'auto_run'    => 1,
 720             'at'          => '0 0 * * *',
 721             'next_run'    => '2005-12-30 00:00:00 EST',
 722             'event'       => '/cron/build_rss'
 723         },
 724     ]
 725
 726 =head1 INTERNAL METHODS
 727
 728 The following methods are extended by this plugin.
 729
 730 =over 4
 731
 732 =item dispatch
 733
 734 The main scheduling logic takes place during the dispatch phase.
 735
 736 =item dump_these
 737
 738 On the Catalyst debug screen, all scheduled events are displayed along with
 739 the next time they will be executed.
 740
 741 =item setup
 742
 743 =back
 744
 745 =head1 SEE ALSO
 746
 747 L<crontab(5)>
 748
 749 =head1 AUTHOR
 750
 751 Andy Grundman, <andy@hybridized.org>
 752
 753 =head1 COPYRIGHT
 754
 755 This program is free software, you can redistribute it and/or modify it
 756 under the same terms as Perl itself.
 757
 758 =cut