source: main/trunk/greenstone2/perllib/plugins/BaseMediaConverter.pm

###########################################################################
#
# BaseMediaConverter - helper plugin that provide base functionality for 
#                  image/video conversion using ImageMagick/ffmpeg
#
# A component of the Greenstone digital library software
# from the New Zealand Digital Library Project at the 
# University of Waikato, New Zealand.
#
# Copyright (C) 2008 New Zealand Digital Library Project
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program; if not, write to the Free Software
# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
#
###########################################################################
package BaseMediaConverter;

use PrintInfo;

use convertutil;

use strict;
no strict 'refs'; # allow filehandles to be variables and viceversa
use gsprintf 'gsprintf';

BEGIN {
    @BaseMediaConverter::ISA = ('PrintInfo');
}

my $arguments = [
      { 'name' => "enable_cache",
    'desc' => "{BaseMediaConverter.enable_cache}",
    'type' => "flag",
    'reqd' => "no",
    }

         ];

my $options = { 'name' => "BaseMediaConverter",
        'desc' => "{BaseMediaConverter.desc}",
        'abstract' => "yes",
        'inherits' => "yes",
        'args' => $arguments };

sub new {
    my ($class) = shift (@_);
    my ($pluginlist,$inputargs,$hashArgOptLists,$auxiliary) = @_;
    push(@$pluginlist, $class);

    push(@{$hashArgOptLists->{"ArgList"}},@{$arguments});
    push(@{$hashArgOptLists->{"OptList"}},$options);

    my $self = new PrintInfo($pluginlist, $inputargs, $hashArgOptLists, $auxiliary);

    return bless $self, $class;
}

sub begin {
    my $self = shift (@_);
    my ($pluginfo, $base_dir, $processor, $maxdocs) = @_;

    # Save base_dir for use in file cache
    $self->{'base_dir'} = $base_dir;
}


# This method exists to prevent duplication of long filepaths within the cache dir.
# Given the file location where media or other product files to be cached are generated
# (such as the pages of a PDF file converted to paged images), this subroutine returns
# the relative path the document is to be stored as, within the cache subdirectory.
# e.g. collect/<collection>/cached/<fileroot/numbered-filename.ext>
# will return fileroot/numbered-filename.ext
# e.g.#2 collect/<collection>/import/<fileroot.ext> will return fileroot.ext
sub get_cache_filename_for_location
{
    my $self = shift @_;
    my ($filename, $orig_file_root, $base_dir, $collect_dir) = @_;

    my $cached_dir = &FileUtils::filenameConcatenate($collect_dir,"cached");
    
    # hashmap of regex match to replacement regex
    my %prefixre_to_replacere_map;

    my $orig_file_root_replacere = "";
    if(defined $orig_file_root) {
    $orig_file_root_replacere = "/$orig_file_root";
    }

    # populate hashmap with regex matcher to regex replacement search
    # https://stackoverflow.com/questions/41334509/can-i-use-qq-or-q-instead-of-qw-in-the-following-perl-script
    # https://perldoc.perl.org/perlop#Regexp-Quote-Like-Operators
    $prefixre_to_replacere_map{qr/^$base_dir(.*?)$/} = "";    
    $prefixre_to_replacere_map{qr/^$cached_dir(.*?)$/} = qr/[\/\\][^\/\\]+([\/\\][^\/\\]*)$/;
    $prefixre_to_replacere_map{qr/^$collect_dir\/(tmp\/.*?)$/} = "";    
    $prefixre_to_replacere_map{qr/^$collect_dir(.*?)$/} = "";
    $prefixre_to_replacere_map{qr@^$ENV{'GSDLHOME'}/tmp/[^/]*(.*?)$@} = $orig_file_root_replacere; # prefix this
    #$prefixre_to_replacere_map{qr/^$ENV{'GSDLHOME'}(.*?)$/} = ""; # Not found a real-world use for this yet
    #$prefixre_to_replacere_map{qr//} = qr//; # dummy template line to add additional regex match processing rules
    
    my $file;
    
    # https://stackoverflow.com/questions/3033/whats-the-safest-way-to-iterate-through-the-keys-of-a-perl-hash
    # https://stackoverflow.com/questions/383528/how-can-i-sort-a-hashs-keys-naturally
    # http://www.java2s.com/Code/Perl/Hash/SortHashbyKeysinReverseOrder.htm
    foreach my $key (reverse sort keys %prefixre_to_replacere_map) {
    # reverse sort as we want to try matching more specific "$coll_dir/$subdir" before $coll_dir
    
    #print STDERR "@@@ Key and value: $key\n\t $prefixre_to_replacere_map{$key}\n";

    my $prefixre = $key;
    my $replacere = $prefixre_to_replacere_map{$key};
    
    ($file) = ($filename =~ m/$prefixre/);
    if (!defined $file || $file eq $filename) {
        #print STDERR "\t#### No match\n"; # keep looping looking for the next match
        next;
    } else {
        #print STDERR "\t#### Found match. Applying: $replacere\n";
        if($replacere eq $orig_file_root_replacere) {
        $file = $orig_file_root_replacere.$file if $file;
        } else {
        $file =~ s/$replacere/$1/;
        }
        last; # found and processed a match
    }
    }

    # No matches found, reset $file to $filename
    if(!defined $file) {
    $file = $filename;
    }
    
    $file =~ s/^\/|\\//; # get rid of leading slash from relative filename
    $file =~ s@^(\.(\/|\/))*@@; # get rid of any ./ at the start
    print STDERR "\t@@@ Final cache tail file is: $file\n";

    return $file
}

sub init_cache_for_file
{
    my $self = shift @_;
    my ($filename, $orig_file_root) = @_;
    
    my $verbosity = $self->{'verbosity'};
    my $outhandle = $self->{'outhandle'};
    my $base_dir = $self->{'base_dir'};

    my $collect_dir = $ENV{'GSDLCOLLECTDIR'};
    $collect_dir =~ s/\\/\//g; # Work in Unix style world
    
    # Work out relative filename within 'base_dir'
    $filename =~ s/\\/\//g;
    $base_dir =~ s/\\/\//g;
    
    my $file = $self->get_cache_filename_for_location($filename, $orig_file_root, $base_dir, $collect_dir);

    # Setup cached_dir and file_root

    my ($file_root, $dirname, $suffix)
    = &File::Basename::fileparse($file, "\\.[^\\.]+\$");
    #= &File::Basename::fileparse($conv_file, "\\.[^\\.]+\$");  

    # if dirname is in collections tmp area, remove collect_dir prefix
    $dirname =~ s/^$collect_dir//;

    if ($ENV{'GSDLOS'} eq "windows") {
    # if dirname starts with Windows drive letter, strip it off
    $dirname =~ s/^[a-z]:\///i;
    }

    my $base_output_dir = &FileUtils::filenameConcatenate($collect_dir,"cached",$dirname);

    if (!-e $base_output_dir ) {
    print $outhandle "Creating directory $base_output_dir\n"
        if ($verbosity>2);

    &FileUtils::makeAllDirectories($base_output_dir);
    }


    #print STDERR "@@@@ base_output_dir: $base_output_dir\n";
    #print STDERR "@@@@ file_root: $file_root\n";

    my $output_dir = &FileUtils::filenameConcatenate($base_output_dir,$file_root);

    if (!-e $output_dir) {
    print $outhandle "Creating directory $output_dir\n"
        if ($verbosity>2);

    &FileUtils::makeAllDirectories($output_dir);
    }

    $self->{'cached_dir'} = $output_dir;
    $self->{'cached_file_root'} = $file_root;    
}



sub run_general_cmd
{
    my $self = shift @_;
    my ($command,$print_info) = @_;


    if (!defined $print_info->{'verbosity'}) {
    $print_info->{'verbosity'} = $self->{'verbosity'};
    }

    if (!defined $print_info->{'outhandle'}) {
    $print_info->{'outhandle'} = $self->{'outhandle'};
    }

    
    return &convertutil::run_general_cmd(@_);
}


sub regenerate_general_cmd
{
    my $self = shift @_;
    my ($command,$ifilename,$ofilename,$print_info) = @_;

    if (!defined $print_info->{'verbosity'}) {
    $print_info->{'verbosity'} = $self->{'verbosity'};
    }

    if (!defined $print_info->{'outhandle'}) {
    $print_info->{'outhandle'} = $self->{'outhandle'};
    }

    return &convertutil::regenerate_general_cmd(@_);
}



sub run_uncached_general_cmd
{
    my $self = shift @_;

    my ($command,$ifilename,$ofilename,$print_info) = @_;

    return $self->run_general_cmd($command,$print_info);
}



sub run_cached_general_cmd
{
    my $self = shift @_;

    my ($command,$ifilename,$ofilename,$print_info) = @_;

    if (!defined $print_info->{'verbosity'}) {
    $print_info->{'verbosity'} = $self->{'verbosity'};
    }

    if (!defined $print_info->{'outhandle'}) {
    $print_info->{'outhandle'} = $self->{'outhandle'};
    }

    return &convertutil::run_cached_general_cmd(@_);
}



sub autorun_general_cmd
{
    my $self = shift @_;

    my ($command,$ifilename,$ofilename,$print_info) = @_;

    my $result;
    my $regenerated;
    my $had_error;

    if ($self->{'enable_cache'}) {
    ($regenerated,$result,$had_error)
        = $self->run_cached_general_cmd($command,$ifilename,$ofilename,$print_info);
    }
    else {
    $regenerated = 1; # always true for a command that is always run
    ($result,$had_error)
        = $self->run_general_cmd($command,$print_info);
    }

    return ($regenerated,$result,$had_error);
}


#
1;