#   ARGUMENTS:          engine_figurelinks.pl xx_manual_vvv
#                       where xx = manual code, vvv = version
#
#   MODIFICATIONS:
#
#----------------------------------------------------------------------

use strict;
use warnings;
use diagnostics;
#use Env qw(SERVER_NAME);
#use CGI qw(:standard :netscape);
use File::Copy;    # Perl supplied module for making copies
#new CGI;

#----------------------------------------------------------------------

my $manualdir_param = shift @ARGV;

my $working_dir = $manualdir_param;
$working_dir =~ s/manualdir=//i;

my $data_area = "/tmp";
my $html_dir  = "$data_area/$working_dir";

my %figures;

#----------------------------------------------------------------------

# Loop to locate HTML files, change permissions, and make working temporary copies

opendir my $htmlstories, "$html_dir" or die "HTML dirs do not exist: $!\n";
my @FigureArray = grep { /^09\w{1,5}00$/ } readdir($htmlstories);
closedir $htmlstories;

foreach my $FigFile (@FigureArray) {
    next unless (-d $FigFile);
    
    opendir my $htmstory, "$html_dir/$FigFile"
      or die "Directory does not exist: $!\n";
    my @FileArray = grep { /a\.htm$/ } readdir($htmstory);
    closedir $htmstory;

    foreach my $DirFile (@FileArray) {
        my $filename = "$html_dir/$FigFile/$DirFile";
        
        next unless (-f $filename);

        copy( $filename, $filename . '.bak' )
          or die "Can not make backup copy of file: $1";

        chmod 0600, $filename;

        open my $fh, '<', $filename or die "Could not open file: $!\n";
        my $figure;
        while ( my $line = <$fh> ) {
            if ( $line =~ /(<IMG SRC=.*?>)/ ) {
                $figure = $1;
                next;
            }
            if ( $line =~ /(Figure \d+)/ ) {
                $figures{$1} = $figure;
            }
        }
        close $fh;
    }
}

print "$_ => ",$figures{$_},"\n" for sort keys %figures;