#!/usr/bin/perl -w
#
#  Perform a 'fake build' to test the 'makebuild' script.
#  060222 liverpole
#
                                                                                
# Strict
use strict;
use warnings;
                                                                                
# Flush output
$|++;
                                                                                
# Things to pretend to build
my @modules = qw( admin drivers tools );
                                                                                
# Do a simulated 'make clean'
map { unlink("$_.txt") } @modules;  # Unlink each module's logfile
unlink "cvstag.txt";                # This one's special
                                                                                
# Pretend to build everything
sleep 1;
foreach (@modules) {
    print STDERR "Building module '$_' ...\n";
    system("touch $_.txt");
    print STDERR " - phase 1\n"; sleep 1;
    print STDERR " - phase 2\n"; sleep 1;
    print STDERR " - phase 3\n"; sleep 1;
}
                                                                                
# Pretend to perform the tagging procedure
print STDERR "CVS tagging ...\n";
system("touch cvstag.txt");
for (my $i = 1; $i <= 16; $i++) {
    sleep 1;
    print STDERR "Tagging file $i\n";
}

##</code><code>##

#!/usr/bin/perl -w
#
#  Test program to demonstrate the differing behavior when a global
#  filehandle is used, vs. a deeply-bound lexical in a forked closure.
#
#  060222 liverpole
#

# Strict
use strict;
use warnings;

# User-defined
my $b_use_global_fh = 0;

# Libraries
use File::Basename;
use FileHandle;
use IO::Select;

# Declarations
sub monitor_build;
sub monitor_logfiles;
sub system_command;                   

# Globals
$| = 1;
my $iam = basename $0;
my $global_fh;


####################
### Main program ###
####################

# Remove the previous build
system("rm -f *.txt");

# Construct a global filehandle
$global_fh = new FileHandle;

# Perform build -- fork occurs within subroutine, and only parent returns
print STDERR "Starting build\n";
monitor_build("./fakebuild");
print STDERR "\e[101m(2) Parent back from monitor_build()\e[m\n";

# Parent can now tend to other business...
print STDERR "Notifying users of build completion ...\n"; sleep 1;
print STDERR "Adding build version to Bugzilla ...\n";    sleep 1;
print STDERR "Building .iso images ...\n";                sleep 1;


###################
### Subroutines ###
###################

#
#   Inputs:  $1 ... the build command
#
#  Results:  Issues the build command to the system and monitors its progress.
#
sub monitor_build {
    my ($bld_cmd) = @_;
    my @logfiles = qw( admin drivers tools cvstag );
    my $plogs = { map { "$_" . ".txt", 1 } @logfiles };

    my $psyscmd = system_command("$bld_cmd 2>&1");
    my $b_finished = 0;

    while (1) {
        my $ptext = $psyscmd->(8);
        last unless $ptext;

        foreach my $line (@$ptext) {
            print "Text from build  [$line]\n";
        }

        if (!$b_finished && monitor_logfiles($plogs)) {
            # The build has finished (except for the CVS tagging phase),
            # so we fork, to let the parent return and complete other tasks
            # (eg. user-notify, adding version number to Bugzilla, etc.)
            # The child continues until the tagging is complete.  We also
            # set $b_finished so this block doesn't get executed again.
            #
            my $pid = fork;
            defined($pid) or die "$iam:  unable to fork!\n";

            if ($pid) {
                # Parent
                print STDERR "\e[101m(1a) Parent about to return\e[m\n";
                return;
            }

            # Child
            print STDERR "\e[102m(1b) Child continues tagging\e[m\n";
            $b_finished = 1;
        }

        select(undef, undef, undef, 0.250);
    }

    print STDERR "\e[102m(3) Child is finished -- exiting\e[m\n";
    exit;   # The build finished -- no need for the child to continue
}


#
#   Inputs:  $1 ... a pointer to the hash of logfile names
#
#  Outputs:  $1 ... nonzero if CVS tagging has started ("cvstag.txt" has
#                   been created), zero otherwise.
#
#  Results:  finds any build logfiles have been written to, logs their names
#            and date, and removes them from the hash.
#
sub monitor_logfiles {
    my ($plogs) = @_;
    my %modified;
    foreach my $logfile (keys %$plogs) {
        (-e $logfile) and $modified{$logfile} = (stat($logfile))[9];
    }
    my $b_cvs_tagging = 0;
    map {
        print STDERR "Started log '$_'\n";
        delete $plogs->{$_};
        ($_ eq 'cvstag.txt') and $b_cvs_tagging = 1;
    } sort { $modified{$a} <=> $modified{$b} } (keys %modified);
    return $b_cvs_tagging;
}


#
#   Inputs:  $1 ... a command to issue to the shell
#
#  Outputs:  $1 ... a closure which reads successive lines of process output
#
#  Results:  Opens an output pipe from the given command and returns a closure
#            which reads non-blocking text from the pipe and returns a pointer
#            to it.  The closure takes a single argument -- the maximum number
#            of lines of text to read on each call (0 = unlimited).  A zero is
#            returned when the command finishes.
#
sub system_command {
    my ($cmd) = @_;

    # Create a pipe to the command
    my $fh = $b_use_global_fh?  $global_fh: new FileHandle;
    open($fh, "$cmd|") or die "$iam:  Cannot pipe to command '$cmd' ($!)\n";

    # Create a Select object
    my $select = IO::Select->new();
    $select->add($fh);
    my $b_done_syscmd = 0;

    # Create the monitoring closure
    my $psub = sub {
        my ($maxlines) = @_;
        $b_done_syscmd and return 0;

        my @lines;
        while (1) {
            last unless $select->can_read(0);
            defined(my $line = <$fh>) or $b_done_syscmd = 1;
            last if $b_done_syscmd;
            chomp $line;
            push @lines, $line;
            last if ($maxlines > 0 && @lines == $maxlines);
            select(undef, undef, undef, 0.250);
        }
        return \@lines;
    };

    return $psub;
}