Perl Pseudo Threads

use strict;
use warnings;
use File::Spec;
use Xchat qw(:all);
 
hook_command("pseudothread", \&cmd_hook);
 
my $tutorial_path = File::Spec->catdir(get_info('xchatdirfs'),'tutorial');
my $pseudothread_script = File::Spec->catdir($tutorial_path, 'pseudothread-fork.pl');
my $timer;
 
sub cmd_hook {
        my $result_file = 'pseudothread.completed';
        system ('perl', $pseudothread_script, $tutorial_path, $result_file, (defined $_[1][1] ? $_[1][1] : ()));
        $timer = hook_timer(1000, \&pseudo_thread_timer, {data=>File::Spec->catdir($tutorial_path, $result_file)});
        return EAT_XCHAT;
}
 
sub pseudo_thread_timer {
        my $check_file = $_[0];
        if (!-e $check_file) {
                prnt ("$check_file Does Not Exist");
                return KEEP;
        }
        else {
                prnt ("$check_file Does Exist");
                # read the contents and display
                open (RESULT, '<', $check_file);
                while (<RESULT>) {
                        prnt $_;
                }
                close RESULT;
                # now delete it, so it can be called again
                unlink $check_file;
                return REMOVE;
        }
}

[Get Code]

tutorial/pseudothread-fork.pl
use strict;
use warnings;
use File::Spec;
 
my $resultfile = File::Spec->catdir($ARGV[0], $ARGV[1]);
 
# in our method of tracking the thread completion, we must be able to write to the out file
# but it cannot exist before hand, since it is deleted after it is read
if (-d $ARGV[0] && -w $ARGV[0] && !-e $resultfile) {
        # standard fork behavior to follow!
        my $pid = fork;
 
        # here is where the "thread" goes, with all forks, the $pid at this point is set to 0
        if ($pid == 0) {
                # the sleep is just an example to show the non blocking nature of this method
                sleep (3);
                # Attempt to open for writing, it is -w, so it SHOULD, but can't be to safe0
                if (open (RESULT, '>', $resultfile)) {
                        print RESULT (defined $ARGV[2] ? $ARGV[2] : "George!");
                        close RESULT; # close that file handle!
                }
        }
 
}
 
# all done, either the parent will continue at the point of the system call, or the fork process will just terminate

[Get Code]