Schedule::Cron looks like it might do what you want.

"The first rule of Perl club is you do not talk about Perl club."
-- Chip Salzenberg

I need millisecond precision. and btw the code works but dies eventually with a segmentation fault and I can't seem to track it down. :(

Have you considered using POE ? If you have Time::HiRes installed, POE::Kernel will use it for timed events. And your code will be much shorter, with more elegant structure, and thus easier to maintain.

Here is a simple scheduler example:

use POE;
 
$DELAY = 0.5;  # every half a second
 
sub do_something {
    my $kernel = $_[KERNEL];
 
    print "Hello boy..\n";
 
    $kernel->delay('wake_up!', $DELAY);
}
 
POE::Session->new(
    _start      => sub {
            my $kernel = $_[KERNEL];
 
            $kernel->delay('wake_up!', $DELAY);
            print "Session is started..\n";
        },
    _stop       => sub {
            print "Session is stopped.\n";
        },
    'wake_up!'   => \&do_something,
);
 
$poe_kernel->run;
[download]

#!/usr/local/bin/perl -d

use Data::Dumper;
use Time::HiRes qw ( gettimeofday setitimer ITIMER_REAL time );
use Carp qw (cluck);

my %schedule;
my %current_event=(time=>'', event=>'');

my $d=undef;
my $DOWARN=0;
my $IMMEDIATELY=0.001;

BEGIN { $SIG{'__WARN__'} = sub { warn $_[0] if $DOWARN } };
$SIG{SEGV} = sub        {
                                my $item;
                                print "\n=============================
+========================\n";
                                print Dumper %schedule;
                                foreach $item (keys %schedule)
                                {
                                        print "- $item\n";
                                }
                                print "===============================
+======================\n";
                                cluck("wah");
exit(1);
                        };

$alarm_triggered=0;
$SIG{ALRM} = sub        { 
                                $alarm_triggered=1;
                        };
sub set_next_alarm
{
        my $next=0;
        my $key;

        print "Executing: ";
        print time, ": ";
        print "$current_event{time} - $current_event{event}{data}\n"; 
        my ($time, $event)=shift_next_schedule(\%schedule);
        if ($time)
        {
                $current_event{time}=$time;
                $current_event{event}=$event;

                my ($seconds, $microseconds) = gettimeofday;
                $seconds+=$microseconds/1000000;

                my $next_alarm=$time-$seconds;
                setitimer(ITIMER_REAL, 0);

                if ($next_alarm < $IMMEDIATELY)
                {
                        $next=$IMMEDIATELY;
                        print "IMMEDIATELY=$IMMEDIATELY\n";
                }
                else
                {
                        $next=$next_alarm;
                        print "Setting new alarm\n";
                }
        }
        else
        {
                $current_event{time}='';
                $current_event{event}='';
                $next=0;
                warn Dumper %schedule;
                print "Reset Timer\n";
        }
        my $left=0;
        foreach $key (keys %schedule)
        {
                $left+=scalar(@{$schedule{$key}});
        }
        print "Done Executing ... $left alarms left\n";
        setitimer(ITIMER_REAL, $next);
        return $left;
};


sub add_schedule
{
        warn "\nAdd:\n";
        my ($schedule, $time, $event)=@_;
        my $key;

        my $array={};
        foreach $key (keys %{$event})
        {
                $array->{$key}=$event->{$key};
        }

        push(@{$schedule->{$time}}, $array);

        ($time, $event)=get_next_schedule(\%schedule);

        if ($current_event{time})
        {
                if ($time < $current_event{time})
                {
                        shift_next_schedule(\%schedule);

                        my ($seconds, $microseconds) = gettimeofday;
                        $seconds+=$microseconds/1000000;

                        unshift_next_schedule(\%schedule, $current_eve
+nt{time}, $current_event{event});
print "Current_event: time=" . ($current_event{time} - $seconds) . "\n
+";
                        $current_event{time}=$time;
                        $current_event{event}=$event;

                        setitimer(ITIMER_REAL, 0);

                        my $next_alarm=$time-$seconds;
                        if ($next_alarm < $IMMEDIATELY)
                        {
                                setitimer(ITIMER_REAL, $IMMEDIATELY);
print "1) Timer set to IMMMEDIATELY\n";
                        }
                        else
                        {
                                setitimer(ITIMER_REAL, $next_alarm);
print "1) Timer set to next alarm $next_alarm\n";
                        }
                }

        }
        else
        {
                ($time, $event)=shift_next_schedule(\%schedule);

                $current_event{time}=$time;
                $current_event{event}=$event;

                setitimer(ITIMER_REAL, 0);

                my ($seconds, $microseconds) = gettimeofday;
                $seconds+=$microseconds/1000000;

                my $next_alarm=$time-$seconds;
                if ($next_alarm < $IMMEDIATELY)
                {
                        setitimer(ITIMER_REAL, $IMMEDIATELY);
print "2) Timer set to IMMMEDIATELY\n";
                }
                else
                {
                        setitimer(ITIMER_REAL, $next_alarm);
print "2) Timer set to next alarm $next_alarm\n";
                }
        }
        warn Dumper %schedule;
}

sub shift_next_schedule
{
        warn "\nPOP:\n";
        my ($schedule)=@_;
        my ($key, $value);

        open (DUMP, ">dump");
        my $x=Dumper %schedule;
        print DUMP $x;
        close (DUMP);
        my @keys = sort { $a <=> $b } (keys %schedule);
        foreach $key (@keys) {
                $value = shift(@{$schedule->{$key}});
                delete $schedule->{$key} if (!@{$schedule->{$key}});
                warn Dumper %schedule;
                return ($key, $value);
        }
}

sub unshift_next_schedule
{
        warn "\nPOP:\n";
        my ($schedule, $time, $event)=@_;

        unshift(@{$schedule->{$time}}, $event);
        warn Dumper %schedule;
}

sub get_next_schedule
{
        my ($schedule)=@_;
        my ($key, $value);

        my @keys = sort { $a <=> $b } (keys %schedule);
        foreach $key (@keys) {
                $value = $schedule->{$key}[0];
                return ($key, $value);
        }
}
{
        {
                my ($seconds, $microseconds) = gettimeofday;
                #$alarm=$seconds+$microseconds/1000000+$i+$b/10+00;
                my $alarm=$seconds+$microseconds/1000000;

                for ($a=0; $a<1000; $a++)
                {
                        print "$a\n";
print "!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!\n"
+ if (! keys %schedule);
        open (DUMP, ">dump1") or die "Could not open dump1";
        my $x=Dumper %schedule;
        print DUMP $x;
        close (DUMP);
warn "b4 sort\n";
        my @keys = sort { $a <=> $b } (keys %schedule);
warn "after sort\n";
warn "Current event\n";
warn Dumper %current_event;
                        eval
                        {
                                warn "00000000000000000000000\n";
                                warn Dumper %schedule;
                                warn "00000000000000000000000\n";
                                my $i=int(rand(26))+.01;
                                my %a=("short_message"=>chr(65+int($i)
+), "data"=>chr(65+int($i)));
                                add_schedule(\%schedule, $alarm+$i, \%
+a);
                                if ($alarm_triggered)
                                {
                                        $alarm_triggered=0;

print "before\n";
                                        set_next_alarm();
print "after\n";
                                }
                        };
                        print "+++++++++++++++++++++ $@\n" if ($@);
                }
                print "ERROR: \n" if ($@);
        }
}

my $event='a';
my $counter=0;

my $a=0;
while (1)
{

        print "------------ $a  - $alarm_triggered ------------------\
+n";
        if ($alarm_triggered)
        {
                $alarm_triggered=0;
                if (!set_next_alarm())
                {
#                       my ($seconds, $microseconds) = gettimeofday;
#                       $alarm=$seconds+$microseconds/1000000+rand(2);
#                       print "Scheduling: ";
#                       $i=int(rand(26));
#                       print " (" . chr(65+$i) .") - $alarm\n";
#                       %a=("short_message"=>chr(65+$i), "data"=>$i);
#                       eval
#                       {
#                               warn Dumper %schedule;
#                               add_schedule(\%schedule, $alarm, \%a);
#                       };
                }
        }
        $a++;
        select(undef, undef, undef, 1);
}
[download]

Edited by footpad, ~ Wed Sep 18 15:35:07 2002 (UTC) : Reparented to (and retitled to match) original node, per Consideration.

Before diving into this code, I have a few things to mention:

• Instead of starting a new thread with correct code, update the existing thread, informing others of the change as an addendum (davorg already considered this node for that reason).
• In the previous node, pope mentioned that POE::Kernel uses Time::HiRes for scheduling, which should probably accomodate your needs.
• In a few places your script has lines to the effect of

  print "\n=====================================================\n";
  [download]

  which can be accomplished with more readability as print "\n", "=" x 55, "\n";, using Perl's repetition operator (x).

Beyond these minor editing considerations, the code looks good (preliminarily, as I said, I haven't dived into it yet, just had a few points to bring up). :)

Sorry for my protocol errors, this is the first time I submit to this forum. Don't get me wrong, the code works ... up to a point. I can schedule events with millisecond accuracy using Time::Hires, but the code dies unexpectedly with a segmentation fault, and that is what's bugging me. :) fred

Some more cleanup you should consider to try and find your bug(Im not sure where the bug is, but my cleaned up version works!):
• Put use strict; use warnings; at the start!!!
• Put the init of the timer in a separate sub. You do exactly the same thing in 3 different places(twice in add_schedule, once in set_next_alarm)
• Try do decide if you want to use %schedule as a global variable or as an argument to the functions. You use it both ways in several places, which is quite confusing.
• Whats with all the extra blocks and the eval where you initilize all the events? Try cleaning that section up, and you might notice a few useless statements that can be removed.
• Try marking out all the debugging code a bit clearer. Its kind of hard to see what is debugging statements and what is actually code.
• Oh, and since you allready have accessor functions for %schedule, try using them whenver you manipulate the hash. Makes it a lot easier if you want to try and make it more efficient later on.
• Perhaps the checking for the alarm and executing the event should be a separate sub? What about just setting $alarm_triggered to one when you you decide that the next event should be executed imediately, and bypassing the alarm?

Btw, what version of perl are you using, and on what platform. I seem to remember that there was some problem with signal handling some versions ago.

Good luck,

Goldclaw

Goldclaw, thanx for you comments. I am running 5.6.1 for i686-linux (red-hat 7.2 (P-II)), as well as a Sun Ultra-10. Any possibility that I could see your cleaned up code? (this code has stumped me for a week now :( ) :) fred fred@worldonline.co.za