source: trunk/gsdl/perllib/plugins/ImagePlug.pm@ 2226

###########################################################################
#
# ImagePlug.pm -- simple text plugin
# A component of the Greenstone digital library software
# from the New Zealand Digital Library Project at the 
# University of Waikato, New Zealand.
#
# Copyright (C) 1999 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 ImagePlug;

use BasPlug;

sub BEGIN {
    @ISA = ('BasPlug');
}

use strict;

sub print_usage {
    my ($plugin_name) = @_;

    print STDERR "
  usage: plugin ImagePlug [options]

   -noscaleup       Don't scale up small images when making thumbnails

   -thumbnailtype s Make thumbnails in format 's'

   -thumbnailsize n Make thumbnails of size nxn

   -convertto s     Convert main inage to (gif|png|jpg)

   -minimumsize n   Ignore images smaller than n bytes

"
}

sub new {
    my ($class) = @_;
    my $plugin_name = shift (@_);
    my $self = new BasPlug ("ImagePlug", @_);

    if (!parsargv::parse(\@_,
             q^noscaleup^, \$self->{'noscaleup'},
             q^thumbnailtype/.*/gif^, \$self->{'thumbnailtype'},
             q^converttotype/.*/^, \$self->{'converttotype'},
             q^thumbnailsize/[0-9]*/100^, \$self->{'thumbnailsize'},
             q^minimumsize/[0-9]*/100^, \$self->{'minimumsize'},
             "allow_extra_options")) {
    
    print STDERR "\nImagePlug uses an incorrect option.\n";
    print STDERR "Check your collect.cfg configuration file.\n";
        &print_usage($plugin_name);
    die "\n";
    }

    return bless $self, $class;
}

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

    return q^(?i)(\.jpe?g|\.gif|\.png|\.bmp|\.xbm|\.tif?f)$^; 
}

sub run_convert {
    my $self = shift (@_);
    my $filename = shift (@_);
    my $file = shift (@_);
    my $doc_obj = shift (@_);
    my $section = $doc_obj->get_top_section();

    if ($file eq "" || $filename eq "") {
    return "";
    }
#    if ($filename =~ m/thumbnail/) {
#   return "";
#    }
#    if ($filename =~ m/converted/) {
#   return "";
#    }
    if ($filename =~ m/ /) {
    print STDERR "IamgePlug: \"$filename\" contains a space. choking.\n";
    return "";
    }

    my $minimumsize = $self->{'minimumsize'};
    my $thumbSize = $self->{'thumbnailsize'};
    if ($thumbSize eq "") { $thumbSize = 100; };
    my $converttotype = $self->{'converttotype'};
    my $thumbnailtype = $self->{'thumbnailtype'};
    if ($thumbnailtype eq "") { $thumbnailtype = "gif"; };
    my $originalfilename = ""; # only set if we do a conversion
    my $thumbnailfilename = "";
    
    my $type = "unknown";

    if (defined $minimumsize && (-s $filename < $minimumsize)) {
        print STDERR "ImagePlug: \"$filename\" too small, skipping\n"
        if $self->{'verbosity'} > 1;
    }
    #see if we need to convert ...
    if ($converttotype ne "" && $filename =~ m/$converttotype$/) {
    $originalfilename = $filename;
    $filename = &util::get_tmp_filename();
    $filename = "$filename.$converttotype";
    $self->{'tmp_filename'} = $filename;
    if (-e $filename) {
        print STDERR "File names to convert from and to are the same. choking in Imageplug on \"$filename\"\n";
        return "";
        }
    my $result = "";
    my $command = "convert -verbose $originalfilename $filename";
    $result = `$command`;
    print STDERR "$command\n"
        if $self->{'verbosity'} > 2;
    print STDERR "$result\n"
        if $self->{'verbosity'} > 3;
    $type = $converttotype;
    }
    
    #check that the thumbnail doesn't already exist ...
    $thumbnailfilename = &util::get_tmp_filename();
    $thumbnailfilename = $thumbnailfilename . ".thumbnail.$thumbnailtype";
    $self->{'tmp_filename2'} = $thumbnailfilename;

    #make the thumbnail
    my $result = "";
    my $command = "convert -verbose -geometry $thumbSize" . "x$thumbSize $filename $thumbnailfilename";
    $result = `$command` ;
    print STDERR "$command\n"
        if $self->{'verbosity'} > 2;
    print STDERR "$result\n"
        if $self->{'verbosity'} > 3;
    
    if ($result =~ m/([0-9]+)x([0-9]+)=>([0-9]+)x([0-9]+)/) {
    $doc_obj->add_metadata ($section, "ImageWidth", $1);
    $doc_obj->add_metadata ($section, "ImageHeight", $2);
    $doc_obj->add_metadata ($section, "ThumbWidth", $3);
    $doc_obj->add_metadata ($section, "ThumbHeight", $4);
    }
    
    my $size = "unknown";
    if ($result =~ m/^[^\n]* ([0-9]+)b/) {
    $size = $1;
    }
    if ($result =~ m/^[^\n]* ([0-9]+)kb/) {
    $size = 1024 * $1;
    }
    
    if ($result =~ m/^[^\n]*JPE?G/i) {
    $type = "jpeg";
    }
    if ($result =~ m/^[^\n]*GIF/i) {
    $type = "gif";
    }
    if ($result =~ m/^[^\n]*PNG/i) {
    $type = "png";
    }
    if ($result =~ m/^[^\n]*TIF?F/i) {
    $type = "tiff";
    }
    if ($result =~ m/^[^\n]*BMP/i) {
    $type = "bmp";
    }
    if ($result =~ m/^[^\n]*XBM?F/i) {
    $type = "xbm";
    }

    #if there's a leading directory name, eat it...
    $file =~ s/^.*[\/\\]//;
    
    $doc_obj->add_metadata ($section, "ImageType", $type);
    $doc_obj->add_metadata ($section, "Image", "$file");
    $doc_obj->add_metadata ($section, "ImageSize", $size);
    
    #add the thumbnail as an associated file ...
    if (-e "$thumbnailfilename") { 
    $doc_obj->associate_file("$thumbnailfilename","thumbnail.$thumbnailtype","image/$thumbnailtype",$section);
    $doc_obj->add_metadata ($section, "ThumbType", $thumbnailtype);
    $doc_obj->add_metadata ($section, "Thumb", "thumbnail.$thumbnailtype");
    } else {
    print STDERR "ImagePlug: couldn't find \"$thumbnailfilename\"\n";
    }
    
    #add the image as an associated file ...
    $doc_obj->associate_file($filename,$file,"image/$type",$section);
        
    return $type;
}


# The ImagePlug read() function. This function does all the right things
# to make general options work for a given plugin. It calls the process()
# function which does all the work specific to a plugin (like the old
# read functions used to do). Most plugins should define their own 
# process() function and let this read() function keep control.
#
# ImagePlug overrides read() because there is no need to read the actual 
# text of the file in, because the contents of the file is not text...
#
# Return number of files processed, undef if can't process
# Note that $base_dir might be "" and that $file might 
# include directories

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

    my $filename = &util::filename_cat($base_dir, $file);
    return 0 if $self->{'block_exp'} ne "" && $filename =~ /$self->{'block_exp'}/;
    if ($filename !~ /$self->{'process_exp'}/ || !-f $filename) {
    return undef;
    }
    print STDERR "ImagePlug processing \"$filename\"\n"
        if $self->{'verbosity'} > 1;

    $file =~ s/^[\/\\]+//; # $file often begins with / so we'll tidy it up
    
    # create a new document
    my $doc_obj = new doc ($filename, "indexed_doc");
    
    #run convert to get the thumbnail and extract size and type info
    my $result = run_convert($self, $filename, $file, $doc_obj);
    
    if (!defined $result)
    {
    print "ImagePlug: couldn't process \"$filename\"\n";
    return 0;
    }

    #create an empty text string so we don't break downstream plugins 
    my $text = "Dummy text to sidestep display bug.";

    # include any metadata passed in from previous plugins 
    # note that this metadata is associated with the top level section
    my $section = $doc_obj->get_top_section();
    $self->extra_metadata ($doc_obj, $section, $metadata);

    # do plugin specific processing of doc_obj
    return undef unless defined ($self->process (\$text, $pluginfo, $base_dir, 
                         $file, $metadata, $doc_obj));

    # do any automatic metadata extraction
    $self->auto_extract_metadata ($doc_obj);

    # add an OID
    $doc_obj->set_OID();
    $doc_obj->add_text($section, $text);

    # process the document
    $processor->process($doc_obj);

    if (defined $self->{'tmp_filename'} && 
    -e $self->{'tmp_filename'}) {
      util::rm($self->{'tmp_filename'})
    }
    if (defined $self->{'tmp_filename2'} && 
    -e $self->{'tmp_filename2'}) {
      util::rm($self->{'tmp_filename2'})
    }

    return 1;
}

# do plugin specific processing of doc_obj
sub process {
    my $self = shift (@_);
    my ($textref, $pluginfo, $base_dir, $file, $metadata, $doc_obj) = @_;
    my $outhandle = $self->{'outhandle'};
    
    return 1;
}

1;