source: extensions/gsdl-video/trunk/perllib/plugins/MultimediaConverter.pm@ 18556

###########################################################################
#
# MultimediaConverter - helper plugin that does audio and video conversion using 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 MultimediaConverter;

use BaseMediaConverter;


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

use gsprintf 'gsprintf';

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

my $arguments = [
      { 'name' => "converttotype",
    'desc' => "{ImageConverter.converttotype}",
    'type' => "string",
    'deft' => "",
    'reqd' => "no" },
      { 'name' => "minimumsize",
    'desc' => "{ImageConverter.minimumsize}",
    'type' => "int",
    'deft' => "100",
    'range' => "1,",
    'reqd' => "no" },
         ];

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

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

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

    my $self = new BaseMediaConverter($pluginlist, $inputargs, $hashArgOptLists, 1);


    return bless $self, $class;

}



# needs to be called after BasePlugin init, so that outhandle is set up.
sub init {
    my $self = shift(@_);

    my $outhandle = $self->{'outhandle'};

    $self->{'tmp_file_paths'} = ();

    # Check that ffmpeg is installed and available on the path 
    my $multimedia_conversion_available = 1;
    my $no_multimedia_conversion_reason = "";

    # None of this works very well on Windows 95/98...
    if ($ENV{'GSDLOS'} eq "windows" && !Win32::IsWinNT()) {
    $multimedia_conversion_available = 0;
    $no_multimedia_conversion_reason = "win95notsupported";
    } else {

    my $result = `ffmpeg -h 2>&1`;


    if (!defined $result || $result !~ m/^FFmpeg version/) {
        $self->{'ffmpeg_installed'} = 0;
        print $outhandle $result;
        $multimedia_conversion_available = 0;
        $no_multimedia_conversion_reason = "ffmpegnotinstalled";
    }
    else {
        $self->{'ffmpeg_installed'} = 1;
    }
    }

    $self->{'multimedia_conversion_available'} = $multimedia_conversion_available;
    $self->{'no_multimedia_conversion_reason'} = $no_multimedia_conversion_reason;

    if ($self->{'multimedia_conversion_available'} == 0) {
    &gsprintf($outhandle, "MultimediaConverter: {MultimediaConverter.noconversionavailable} ({MultimediaConverter.".$self->{'no_multimedia_conversion_reason'}."})\n");
    }
       
}
    



sub identify { 
    my ($filename, $outhandle, $verbosity) = @_;

    die "MultimediaConvert::identify() needs to be defined by inheriting plugin";
}



sub init_cache_for_file {
    my $self = shift(@_);

    my ($media_filename) = @_;

    $self->SUPER::init_cache_for_file($media_filename);


    # This should probably be replaced with Anu's work that replaced
    # non-ASCII chars with URL encodings

    my $ascii_only_filenames = $self->{'use_ascii_only_filenams'};

    if (defined $ascii_only_filenames && ($ascii_only_filenames)) {
    my $file_root = $self->{'cached_file_root'};
    $self->{'cached_file_root'} = ascii_only_filename($file_root);
    }
                  
    my @ffmpeg_monitor   = ( 'monitor_init'   , "MultimediaConverter::ffmpeg_monitor_init",
                 'monitor_line'   , "MultimediaConverter::ffmpeg_monitor_line",
                 'monitor_deinit' , "MultimediaConverter::ffmpeg_monitor_deinit" );
                    
                    
    $self->{'ffmpeg_monitor'} = \@ffmpeg_monitor;


}




sub ascii_only_filename
{
    my ($file) = @_;

    my $file_unicode = pack("U0C*", map { ord($_) } split(//,$file)); # force explicitly to unicode

    my @ascii_only_chars 
    = map { $_ >= 128 # if non-ascii
            ? "" 
            :  chr($_) } unpack("U*", $file_unicode); # unpack Unicode characters

    my $ascii_file = join("",@ascii_only_chars);

    if ($ascii_file eq "") {
    print STDERR "Warning: filename includes no ASCII characters\n";
    print STDERR "         Keeping as original filename\n";
    $ascii_file = $file;
    }

    return $ascii_file;
}


sub remove_difficult_chars
{
    my $self = shift @_;

    my ($file) = @_;

    # remove problematic characters from filename that make using it in a URL difficult

    my $file_unicode = pack("U0C*", map { ord($_) } split(//,$file)); # force explicitly to unicode

    my $url = $file_unicode;
    $url =~ s/\x{2018}|\x{2019}|\x{201C}|\x{201D}//g; # remove smart quotes as cause problem in URL for streaming web server
    $url =~ s/\x{2013}/\-/g; # change en-dash to '-' as again causes problems for streaming web server
    
    return $url;
}


sub url_safe
{
    my $self = shift @_;

    my ($file) = @_;
    
    my @url_utf8_chars 
    = map { $_ >= 128 # if non-ascii
            ? "%" . sprintf("%02X", $_) 
            :  chr($_) } unpack("U*", $file); # unpack Unicode characters

    my $url = join("",@url_utf8_chars);


    return $url;
}



sub gsdlhome_independent
{
    my $self = shift @_;
    my ($filename) = @_;

    my $gsdlhome = $ENV{'GSDLHOME'};
    my $filename_gsdlenv = $filename;
    $filename_gsdlenv =~ s@^$gsdlhome@\$GSDLHOME@;

    return $filename_gsdlenv;
}


sub ffmpeg_monitor_init
{
    my $saved_record_sep = $/;
    $/ = "\r";

    my $saved_buffer_len = $|;
    $| = 1;

    my $saved_rec = { 'saved_record_sep' => $saved_record_sep,
              'saved_buffer_len' => $saved_buffer_len };

    return $saved_rec;
}



sub ffmpeg_monitor_deinit
{
    my ($saved_rec) = @_;

    my $saved_record_sep = $saved_rec->{'saved_record_sep'};
    my $saved_buffer_len = $saved_rec->{'saved_buffer_len'};

    $/ = $saved_record_sep;
    $| = $saved_buffer_len;
}


sub ffmpeg_monitor_line
{
    my ($line) = @_;
    
    my $had_error = 0;
    my $generate_dot = 0;

    if ($line =~ m/^frame=/) 
    {
    $generate_dot = 1;
    }

    return ($had_error,$generate_dot);
}




1;