oops, posted incorrect code. the correct one follows (still dies eventually with a segmentation fault):

#!/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.