#!/usr/pkg/bin/perl
# Generate all *.seq files for playing out RLDA files in the process
# Road Surface Output of MultiPurpose TestWare by MTS. Sequencing is
# ordered according to the customary 'rule of three'.
# Lines of code = 148
# Comment lines = 26

use strict;
use Cwd;

my ($in_path, $prefix) = @ARGV;
my $default_input = 'rule-of-three.dat';
my $default_dir = cwd();

# If not given as CLI arg, get input file path via STDIN.
unless ( defined $in_path ) {
    print "\nDefault input is '$default_input' in current directory as below:\n";
    print "$default_dir/$default_input \n";
    print "Enter full path to *.dat file or just press RETURN for default. \n> ";
    $in_path = <STDIN>;
    chomp $in_path;
    $in_path  = "$default_dir/$default_input" 
        unless $in_path =~ /[A-Z|a-z|0-9|_|-]+\.dat$/;
    $in_path =~ s/\\/\//g; # Unixify file path for Perl.
}
else { print "Input file path: $in_path \n" }

# If not given as CLI arg, get *.drv file prefix via STDIN.
unless ( defined $prefix ) {
    print "\nEnter prefix for *.drv files, if any.\n";
    print "Or just press RETURN for none. \n> ";
    $prefix = <STDIN>;
    chomp $prefix;
    $prefix  = '' unless $prefix =~ /[A-Z|a-z|0-9|_|-]+/;
    $prefix .= '_' unless $prefix eq '';
    while ($prefix =~ /\s/) { $prefix =~ s/[ |__]/_/g }
}
else { print "Prefix for *.drv files: $prefix \n" }

# Cobble together an output path for *.seq files.
my $out_path = $in_path;
$out_path  = s/\/[A-Z|a-z|0-9|_|-]+\t[0-9]+\.dat$/\//;
$out_path .= "$prefix" . "rule-of-three_";

my $suffix  = '.drv';

# Read in the input file.
open IN_FILE, "<$in_path" or die "Oops! Can't open $in_path: $! \n";

# Build an array of anonymous hashes, one for each output *.seq file.
my @rsp_hrefs = ({});
while (<IN_FILE>) {
    if ($_ =~ /[A-Z|a-z|0-9|_|-]+\t[0-9]+/) {
        my ($key, $value) = split "\t", $_;
        $rsp_hrefs[-1]->{$key} = $value;
    }
    else { push @rsp_hrefs, {} }   # Blank lines delimit *.seq file data sets.
}

# Build a pattern for sprintf to innumerate *.seq files. Uses N leading zeros
# so that directory sorting will not look awful.
my $out_cnt = scalar @rsp_hrefs;
my $pattern = '%0' . length($out_cnt) . 'd';


my %playout_totals;

# Used inside sub rule_of_three.
# When the key for any set is zero or below, remove it.
sub delete_key_if_zero {
    my ($href) = @_;
    foreach ( keys %$href ) { 
        if ( $href->{$_} <= 0 ) {
            delete $href->{$_};
        }
    }
}

# Break up output sequence according to the 'rule of 3': highest
# count file 3 times, lowest count file 1 time. Repeat until the
# playout count for all files are zero.
sub rule_of_three {
    my ($href) = @_;
    my $loop_cnt = 0;
    my $sorted;    while ( 1 ) {
        delete_key_if_zero( $href );
        last unless  scalar keys %$href;
        
        my @sorted = sort { $href->{$a} <=> $href->{$b} } keys %$href;

        # Play out 3 passes of highest count rlda file.
        if ( $href->{$sorted[-1]} >= 3 ) { 
            print OUT "\n", $prefix, $sorted[-1], $suffix, "\t", 3;
            $playout_totals{$sorted[-1]} += 3;
        }
        elsif ( $href->{$sorted[-1]} == 2 ) { 
            print OUT "\n", $prefix, $sorted[-1], $suffix, "\t", 2;
            $playout_totals{$sorted[-1]} += 2;
        }
        elsif ( $href->{$sorted[-1]} == 1 ) {  
            print OUT "\n", $prefix, $sorted[-1], $suffix, "\t", 1;
            $playout_totals{$sorted[-1]} += 1;
        }
        $href->{$sorted[-1]} -= 3;

        # Play out one pass of lowest count rlda file. 
        if ( $href->{$sorted[0]} > 0 ) { 
            print OUT "\n", $prefix, $sorted[0], $suffix, "\t", 1;
            ++$playout_totals{$sorted[0]};
            --$href->{$sorted[0]};
        }

        $loop_cnt += 1;
        last if $loop_cnt > 10_000; # Just for safety.
    }
    print "\tLoop count = $loop_cnt \n";
}

# Used prior to sub report_totals.
sub init_totals {
    %playout_totals = ();
    foreach ( @_ ) {
        foreach my $key ( keys %$_ ) {
            add_key_if_needed( \%playout_totals, $key );
        }
    }
}

# Used inside of sub report_totals.
sub add_key_if_needed {
    my ($href, $key ) = @_;
    unless ( defined $href->{$key} ) { $href->{$key} = 0 }
}

# Create a separate file showing totals for error checking.
sub report_totals {
    my ($out_path_full ) = @_;
    my $out_path_dat = $out_path_full;
    $out_path_dat =~ s/\.seq$/_totals.dat/;
    if ( open TOTALS, ">$out_path_dat" ) {
        print TOTALS "Totals for $out_path_full : \n";
        foreach ( sort keys %playout_totals ) {
            printf TOTALS "$_ \t%8s \n", $playout_totals{$_};
        }
        close TOTALS;
    }
    else { print "Oops! Cannot open file for writing sequence totals. \n" }
}

# Create the whole series of *.seq files.
sub write_seq_files {
    my ($out_path, @hrefs) = @_;
    $out_path = cwd() unless $out_path =~ /[A-Z|a-z|0-9|_]+/;
    print "\nWriting *.SEQ files...\n";
    my $file_cnt = 1; 
    init_totals(@hrefs);
    foreach my $href ( @hrefs ) {
        my $out_path_full = sprintf "$out_path$pattern.seq", $file_cnt;
        if ( open OUT, ">$out_path_full" ) {
            print "Writing to $out_path_full \n";
            print OUT 'SEQUENCE';
            rule_of_three( $href );
            close OUT;
            report_totals( $out_path_full );
            ++$file_cnt;
        }
        else { print "Oops! Cannot open $out_path_full for writing. \n" }
    }
    print "All done.\n";
}

write_seq_files($out_path, @rsp_hrefs);

__END__

=head1 NAME

Rule of Three

=head1 SYNOPSIS

perl B<gus_rule-of-three.pl [filepath] [prefix] > 

=head1 DESCRIPTION

Command line (non-GUI) script to create an MTS sequence file for MPT Road Surface Output process.

=head1 INPUT FILES

One input file can serve for any number of output files. A blank line delimits output files. Each non-blank line is ordered thus: FILE TAB COUNT. Refer to the example input fileC< ./rule-of-three.dat > included on the download page. Run the script with that as input to see five *.seq files created therefrom.

=head1 PREFIXES

Suppose, for example, you have a large, common *.RSP file of many channels. Subsets of those channels might be for various components. One would break up this into sub-files for each component. But the same rule-of-three sequence would be played back for each. Using prefixes, one may employ the same input *.dat file to generate any number of unique *.seq files by using file-name prefixes.

=head1 OUTPUT FILES

Output files are generated always in the same directory as the input file. Two output files will be generated. The fileC< *_rule-of-three_??.seq >is the actual sequence file. The fileC< *_rule-of-three_??_totals.dat > is for error checking so that you may cross check your sequence against what is desired without any needless tedium.

=head1 AUTHOR

Gan Uesli Starling <F<gan@starling.us>>

=head1 COPYRIGHT

Copyright (c) 2005, Gan Uesli Starling. All rights reserved.
This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself.

=head1 SCRIPT CATEGORIES

Misc

=cut