Index: /gsdl/trunk/perllib/baseconvert.pm
===================================================================
--- /gsdl/trunk/perllib/baseconvert.pm	(revision 16841)
+++ /gsdl/trunk/perllib/baseconvert.pm	(revision 16841)
@@ -0,0 +1,137 @@
+###########################################################################
+#
+# baseconvert.pm -- provides some fundamental methods for converting files
+#                    using external programming 
+#
+# Copyright (C) 1999 DigiLib Systems Limited, NZ
+#
+# 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 baseconvert;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+
+use convertutil;
+
+sub new {
+    my ($class) = shift @_;
+
+    my ($base_dir,$filename,$verbosity,$outhandle) = @_;
+
+    my $self = {};
+
+    $self->{'verbosity'}    = $verbosity;
+    $self->{'outhandle'}    = $outhandle;
+
+    # Work out relative filename within 'base_dir'
+    my ($file) = ($filename =~ m/^$base_dir(.*?)$/);
+    
+    $file =~ s/^\/|\\//; # get rid of leading slash from relative filename
+
+    # Setup cached_dir and file_root
+
+    my ($file_root, $dirname, $suffix)
+	= &File::Basename::fileparse($file, "\\.[^\\.]+\$");
+
+    my $collect_dir = $ENV{'GSDLCOLLECTDIR'};
+    my $base_output_dir = &util::filename_cat($collect_dir,"cached",$dirname);
+
+    if (!-e $base_output_dir ) {
+	print $outhandle "Creating directory $base_output_dir\n"
+	    if ($verbosity>2);
+
+	&util::mk_all_dir($base_output_dir);
+    }
+
+    my $output_dir = &util::filename_cat($base_output_dir,$file_root);
+
+    if (!-e $output_dir) {
+	print $outhandle "Creating directory $output_dir\n"
+	    if ($verbosity>2);
+
+	&util::mk_dir($output_dir);
+    }
+
+    $self->{'cached_dir'} = $output_dir;
+    $self->{'file_root'} = $file_root;
+    
+    return bless $self, $class;
+}
+
+
+
+sub run_general_cmd
+{
+    my $self = shift @_;
+    my ($command,$options) = @_;
+
+    if (!defined $options->{'verbosity'}) {
+	$options->{'verbosity'} = $self->{'verbosity'};
+    }
+
+    if (!defined $options->{'outhandle'}) {
+	$options->{'outhandle'} = $self->{'outhandle'};
+    }
+
+    
+    return &convertutil::run_general_cmd(@_);
+}
+
+
+sub regenerate_general_cmd
+{
+    my $self = shift @_;
+    my ($command,$ofilename,$options) = @_;
+
+    if (!defined $options->{'verbosity'}) {
+	$options->{'verbosity'} = $self->{'verbosity'};
+    }
+
+    if (!defined $options->{'outhandle'}) {
+	$options->{'outhandle'} = $self->{'outhandle'};
+    }
+
+    return &convertutil::regenerate_general_cmd(@_);
+}
+
+
+
+sub run_cached_general_cmd
+{
+    my $self = shift @_;
+
+    my ($command,$ofilename,$options) = @_;
+
+    if (!defined $options->{'verbosity'}) {
+	$options->{'verbosity'} = $self->{'verbosity'};
+    }
+
+    if (!defined $options->{'outhandle'}) {
+	$options->{'outhandle'} = $self->{'outhandle'};
+    }
+
+    return &convertutil::run_cached_general_cmd(@_);
+}
+
+
+
+
+
+1;
Index: /gsdl/trunk/perllib/convertutil.pm
===================================================================
--- /gsdl/trunk/perllib/convertutil.pm	(revision 16841)
+++ /gsdl/trunk/perllib/convertutil.pm	(revision 16841)
@@ -0,0 +1,299 @@
+###########################################################################
+#
+# convertutil.pm -- utility to help convert files using external applications
+#
+# Copyright (C) 1999 DigiLib Systems Limited, NZ
+#
+# 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 convertutil;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+
+use File::Basename;
+
+
+sub monitor_init
+{
+    # do nothing
+    return {};
+}
+
+sub monitor_deinit
+{
+    my ($saved_rec) = @_;
+    
+    # nothing to do
+}
+
+sub monitor_init_unbuffered
+{
+    my $saved_buffer_len = $|;
+    $| = 1;
+
+    my $saved_rec = { 'saved_buffer_len' => $saved_buffer_len };
+
+    return $saved_rec;
+}
+
+sub monitor_deinit_unbuffered
+{
+    my ($saved_rec) = @_;
+
+    my $saved_buffer_len = $saved_rec->{'saved_buffer_len'};
+
+    $| = $saved_buffer_len;
+}
+
+sub monitor_line
+{
+    my ($line) = @_;
+
+    my $had_error = 0;
+    my $generate_dot = 0;
+
+    return ($had_error,$generate_dot);
+}
+
+sub monitor_line_with_dot
+{
+    my ($line) = @_;
+
+    my $had_error = 0;
+    my $generate_dot = 1;
+
+    return ($had_error,$generate_dot);
+}
+
+
+sub run_general_cmd
+{
+    my ($command,$options) = @_;
+
+
+    # $options points to a hashtable that must have fields for:
+    #  'verbosity', 'outhandle', 'message_prefix' and 'message'
+    #
+    # it can also include functions for monitoring
+    #  'monitor_init'   => takes no input arguments and returns a hashtable for saved data values
+    #  'monitor_line'   => takes $line as input argument, return tuple (had_error,generate_dot)
+    #  'monitor_deinit' => takes the saved data values as input, restores saved values
+    #
+    # Default are provided for these monitor functions if none specified
+
+    my $verbosity = $options->{'verbosity'};
+    my $outhandle = $options->{'outhandle'};
+
+    my $message_prefix = $options->{'message_prefix'};
+    my $message = $options->{'message'};
+
+    my $monitor_init   = $options->{'monitor_init'};
+    my $monitor_line   = $options->{'monitor_line'};
+    my $monitor_deinit = $options->{'monitor_deinit'};
+
+    if (!defined $monitor_init) {
+	$monitor_init = "monitor_init";
+    }
+    if (!defined $monitor_line) {
+	$monitor_line = "monitor_line";
+    }
+    if (!defined $monitor_deinit) {
+	$monitor_deinit = "monitor_deinit";
+    }
+
+    print $outhandle "$message_prefix: $command\n" if ($verbosity > 3);
+    print $outhandle "  $message ..." if ($verbosity >= 1);
+
+    my $command_status = undef;
+    my $result = "";
+    my $had_error = 0;
+
+    my $saved_rec = &$monitor_init();
+
+    if (open(CMD,"$command 2>&1 |"))
+    {
+	my $line;
+
+	my $linecount = 0;
+	my $dot_count = 0;
+
+
+	while (defined ($line = <CMD>))
+	{
+	    $linecount++;
+
+	    my ($had_local_error,$generate_dot) = &$monitor_line($line);
+	    
+	    if ($had_local_error) {
+		# set general flag, but allow loop to continue to end building up the $result line
+		print $outhandle "$line\n";
+		$had_error = 1;
+	    }
+
+	    if ($generate_dot)
+	    {
+		if ($dot_count == 0) { print $outhandle "\n  "; }
+		print $outhandle ".";
+		$dot_count++;
+
+		if (($dot_count%76)==0) 
+		{
+		    print $outhandle "\n  ";
+		}
+	    }
+	
+	    $result .= $line;
+	    
+	}
+	print $outhandle "\n";
+
+	
+	close(CMD);
+
+	$command_status = $?;
+	if ($command_status != 0) {
+	    $had_error = 1;
+
+	    print $outhandle "Error: processing command failed.  Exit status $?\n";
+
+	    if ($verbosity >= 3) {
+		print $outhandle "  Command was: $command\n";
+	    }
+	    if ($verbosity >= 4) {
+		print $outhandle "$message_prefix result: $result\n";
+	    }
+	}
+    }
+    else 
+    {
+	$had_error = 1;
+	print STDERR "Error: failed to execute $command\n";
+    }
+
+    &$monitor_deinit($saved_rec);
+
+    if ($verbosity >= 1) {
+	if ($had_error) {
+	    print $outhandle "  ...error encounterd\n";
+	}
+	else {
+	    print $outhandle "  ...done\n";
+	}
+    }
+
+    if (defined $command_status && ($command_status == 0))
+    {
+	# only want to print the following out if verbosity is high enough
+	# and we haven't already printed it out as a detected error above
+	print $outhandle "$message_prefix result: $result\n" if ($verbosity > 5);
+    }
+
+    return ($result,$had_error);
+}
+
+
+sub regenerate_general_cmd
+{
+    my ($command,$ofilename,$options) = @_;
+
+    my $regenerated = 1;
+    my $result = "";
+    my $had_error = 0;
+
+    ($result,$had_error) = run_general_cmd($command,$options);
+
+    # store command args so can be compared with subsequent runs of the command
+    my $args_filename = "$ofilename.args";
+
+    if (open(ARGSOUT,">$args_filename")) {
+	print ARGSOUT $command;
+	print ARGSOUT "\n";
+	close(ARGSOUT);
+    }
+    else {
+	my $outhandle = $options->{'outhandle'};
+	print $outhandle "Warning: Unable to write out caching information to file $args_filename\n";
+	print $outhandle "         This means $ofilename will be regenerated on next build whether\n";
+	print $outhandle "         processing args have changed or not.\n";
+    }
+
+    return ($regenerated,$result,$had_error);
+}
+
+
+
+sub run_cached_general_cmd
+{
+    my ($command,$ofilename,$options) = @_;
+
+    my $regenerated = 0;
+    my $result = "";
+    my $had_error = 0;
+
+    if (!-e $ofilename) {
+	($regenerated,$result,$had_error) 
+	    = regenerate_general_cmd($command,$ofilename,$options);
+    }
+    else {
+	# file exists => check to see if command to generate it has changed
+	my $args_filename = "$ofilename.args";
+	if (open (ARGSIN,"<$args_filename")) {
+	    my $prev_command = <ARGSIN>;
+	    chomp($prev_command);
+
+	    close(ARGSIN);
+
+	    if (defined $prev_command) {
+		# if commands are different
+		if ($prev_command ne $command) {
+		    # need to rerun command
+		    ($regenerated,$result,$had_error) 
+			= regenerate_general_cmd($command,$ofilename,$options);
+		}
+		else {
+		    my $outhandle = $options->{'outhandle'};
+		    my $verbosity = $options->{'verbosity'};
+
+		    my $message_prefix = $options->{'message_prefix'};
+
+		    my ($ofile) = ($ofilename =~ m/^.*(cached.*)$/);
+
+		    my $ofile_no_dir = basename($ofile);
+		    print $outhandle "  $message_prefix: Cached file $ofile_no_dir already exists.\n";
+		    print $outhandle "  $message_prefix: No need to regenerate $ofile\n" if ($verbosity > 2);
+		}
+		    
+	    }
+	}
+	else {
+	    my $outhandle = $options->{'outhandle'};
+	    my $message_prefix = $options->{'message_prefix'};
+	    
+	    print $outhandle "  $message_prefix: No cached previous args found.  Regenerating $ofilename\n";
+
+	    ($regenerated,$result,$had_error) = regenerate_general_cmd($command,$ofilename,$options);
+	}
+    }
+
+    return ($regenerated,$result,$had_error);
+}
+
+
+1;
Index: /gsdl/trunk/perllib/imageconvert.pm
===================================================================
--- /gsdl/trunk/perllib/imageconvert.pm	(revision 16841)
+++ /gsdl/trunk/perllib/imageconvert.pm	(revision 16841)
@@ -0,0 +1,140 @@
+###########################################################################
+#
+# imageconvert.pm -- utility to help convert image file 
+#                    used by ImagePlug, PagedImgPlug ...
+#
+# Copyright (C) 1999 DigiLib Systems Limited, NZ
+#
+# 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 imageconvert;
+
+use strict;
+no strict 'refs'; # allow filehandles to be variables and viceversa
+
+
+use baseconvert;
+
+sub BEGIN {
+    @imageconvert::ISA = ('baseconvert');
+}
+
+
+
+# Discover the characteristics of an image file with the ImageMagick
+# "identify" command.
+
+sub identify { 
+    my ($image, $outhandle, $verbosity) = @_;
+
+    # Use the ImageMagick "identify" command to get the file specs
+    my $command = "identify \"$image\" 2>&1";
+    print $outhandle "$command\n" if ($verbosity > 2);
+    my $result = '';
+    $result = `$command`;
+    print $outhandle "$result\n" if ($verbosity > 3);
+
+    # Read the type, width, and height
+    my $type =   'unknown';
+    my $width =  'unknown';
+    my $height = 'unknown';
+
+    my $image_safe = quotemeta $image;
+    if ($result =~ /^$image_safe (\w+) (\d+)x(\d+)/) {
+	$type = $1;
+	$width = $2;
+	$height = $3;
+    }
+	
+    # Read the size
+    my $size = "unknown";
+    if ($result =~ m/^.* ([0-9]+)b/) {
+	$size = $1;
+    } elsif ($result =~ m/^.* ([0-9]+)kb/) {
+	$size = 1024 * $1;
+    }
+
+    print $outhandle "file: $image:\t $type, $width, $height, $size\n" 
+	if ($verbosity > 3);
+
+    # Return the specs
+    return ($type, $width, $height, $size);
+}
+
+
+
+
+sub new {
+    my ($class) = shift @_;
+
+    my ($base_dir,$image_filename,$verbosity,$outhandle) = @_;
+
+    my $self = new baseconvert($base_dir,$image_filename,$verbosity,$outhandle);
+    
+    return bless $self, $class;
+}
+
+
+sub stream_cmd_XXXX
+{
+    my $self = shift (@_);
+    my ($ivideo_filename,$video_width,$video_height,
+	$streaming_bitrate,$streaming_size, 
+	$opt_streaming_achan, $opt_streaming_arate) = @_;
+
+    my $streaming_achan 
+	= (defined $opt_streaming_achan) ? $opt_streaming_achan : 2;
+
+    my $streaming_arate 
+	= (defined $opt_streaming_arate) ? $opt_streaming_arate : 22050;
+
+    my $output_dir = $self->{'cached_dir'};
+    my $ivideo_root = $self->{'file_root'};
+
+    my $oflash_file = "${ivideo_root}_stream.flv";
+    my $oflash_filename = &util::filename_cat($output_dir,$oflash_file);
+
+    my $s_opt = $self->optional_frame_scale($streaming_size,$video_width,$video_height);
+
+    my $exp_duration = $self->{'exp_duration'};
+    my $t_opt = (defined $exp_duration) ? "-t $exp_duration" : "";
+
+    my $main_opts = "-y $t_opt";
+
+    my $stream_opts = "-b $streaming_bitrate $s_opt";
+    ### my $stream_opts = "-r 25 $s_opt";
+    $stream_opts .= " -ac $streaming_achan -ar $streaming_arate";
+    $stream_opts .= " -pass 1/2";
+
+    # -flags +ilme+ildct' and maybe '-flags +alt' for interlaced material, and try '-top 0/1'
+
+    my $all_opts = "$main_opts $stream_opts"; 
+    my $ffmpeg_cmd = "ffmpeg  -i \"$ivideo_filename\" $all_opts -y \"$oflash_filename\"";
+
+    return ($ffmpeg_cmd,$oflash_filename,$oflash_file);
+}
+
+
+
+
+
+
+
+
+
+1;
