CMS-Experte | IT-Consultant in Berlin

Mit dem Perl-Skript digicam2web.pl wird aus allen Bildern im JPEG- oder PNG-Format im aktuellen Arbeitsverzeichnis eine Bildergallerie im XHTML-Format erzeugt. Das Skript sollte in ein Verzeichnis kopiert werden, in dem nach ausführbaren Programmen gesucht wird, z. B. /usr/local/bin. Alternativ kann auch ein symbolischer Link angelegt werden. Benutzer können die Bilder entweder mit den Standardeinstellungen verarbeiten oder eigene Werte für Bildgröße und -qualität angeben. Wahlweise kann auch ein Label, dass oben links eingefügt wird, angegeben werden.

Enthalten Dateinamen Zeichen, wie , : ; ~ oder Leerzeichen, werden diese durch Unterstriche ersetzt und die Originaldatei bleibt erhalten. Öffnen Sie nach Abschluss der Verarbeitung die Datei index.html in einem Web-Browser, um die Gallerie zu betrachten. Unter jeder Miniaturansicht (Thumbnail) steht der Name des zugehörigen Bilds und dessen Größe in KB. Durch Klicken auf die Miniaturansicht gelangen Sie zur Einzelansicht.

Dieses Skript wird in einer Shell ausgeführt und erfordert ImageMagick und das Perl-Modul Image::Magick. Für die Ausgabe des HTML-Codes wird das CGI-Modul von Lincoln Stein verwendet. Die Parameter für die Verarbeitung werden nach dem Aufruf des Skripts über die Standardeingabe (STDIN) festgelegt.

#!/usr/bin/perl
# $Id: digicam2web.pl,v 1.0 2005/07/07 23:36:08 ramiro Exp $
#
# This script generates a Web gallery from images in
# JPEG or PNG format.
#
# Copyright (C) 2005 Ramiro Gómez 
# url: www.ramiro.org
#
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
use warnings;
use strict;
use CGI;
use DirHandle;
use Image::Magick;
use Cwd;
# full path to current working directory
my $dir = getcwd;

# assign the name of the current directory
# to the title of the HTML document
my ($title) = $dir =~ m|.*/(.*?)$|;

# by default resize images to
my $resize = '30%x30%';

# quality (compression ratio) of the image
my $quality = 75;

# a label for the images
my $label = undef;

# help message
print <<"EOF";
All JPEG and PNG images in the following directory
will be processed:
$dir
Hit RETURN to use the default value in brackets
or enter the desired value and then hit RETURN.

EOF

# ask for values
print "Use default values for processing images [yes]: ";
my $use_defaults = <STDIN>;
chomp $use_defaults;
unless ($use_defaults eq 'yes' || $use_defaults eq '') {
    # scaling factor or percentage for the images
    print "Scale images to [$resize]: ";
    my $user_resize = <STDIN>;
    chomp $user_resize;
    unless ($user_resize eq '') {
	$resize = $user_resize;
    }
    # quality of the image
    print "Enter a quality between 1 - 100, default is [$quality]: ";
    my $user_quality = <STDIN>;
    chomp $user_quality;
    unless ($user_quality eq '') {
	$quality = $user_quality;
    }
    # use a label for the images
    print "Enter a label if you want to add one [no label]: ";
    my $user_label = <STDIN>;
    chomp $user_label;
    unless ($user_label eq '') {
	$label = $user_label;
    }
}

# declare variables
my %images;
my @table_rows;
my $table_row;
my $td_count = 0; # counter for table cells
my $HTML;
my $q = CGI->new;

# resize images and create thumbnails
map {
    # old file name
    my $old = $_;

    # new image Magick Object
    my $img = Image::Magick->new;
    $img->Read("$old");

    # generate new file name
    my $new = lc $_;
    $new =~ s/[,:;~ ]/_/g;

    # get image file type
    my ($type) = $new =~ m/\.([a-z]+)$/;
    
    # resize to default or user value
    $img->Resize(geometry => $resize);

    # set the quality
    $img->Set(quality => $quality);

    # annotate with label if entered
    if ($label) {
	$img->Annotate(text => $label,
		       font => 'verdana',
		       pointsize => 12,
		       fill => 'white',
		       x => 10,
		       y => 20)
    }

    # save image to new file
    $img->Write("$type:$new");

    # add information to image hash
    my $tn = 'tn_' . $new;
    $images{$tn} = {
		    link => $new,
		    filesize => $img->Get('filesize'),
		    resolution => $img->Get('width') . 'x' . $img->Get('rows')
		    };

    # make thumbnail
    $img->Resize(geometry => '120x120');
    $img->Write("$type:$tn");

    # undefine object
    undef $img;
    print "Created: $new\n";
} pictures($dir);

# prepare output
$HTML .= $q->start_html( -title => $title);
# create table rows with links to images    
map {
    $td_count++;
    my $link = $images{$_}{link};
    my $KB = sprintf( "%.3f", ( $images{$_}{filesize} / 1024 ) );
    my $name = "$link" . $q->br . "$KB KB, " . $images{$_}{resolution};
    $table_row .= $q->td( { -style => "font-size:11px;text-align:center;" },
			  $q->a( { href => $link },
				 $q->img( { src => $_, alt => $name } )
				 ),
			  $q->br . $name );
    if ( $td_count % 5 == 0 ) {
	push @table_rows, $q->Tr( $table_row );
	$table_row = '';
	$td_count = 0;
    }
} sort keys %images;    

# if necessary, fill last table row with empty cells
if ( $td_count < 5 ) {
    my $diff = 5 - $td_count;
    for (1..$diff) {
	$table_row .= $q->td('');
    }
    push @table_rows, $q->Tr( $table_row );
} 

my $table = $q->table( { -width => '80%' }, @table_rows );
$HTML .= $table;
$HTML .= $q->p( { -style => "font-size:11px;text-align:center;" },
		$q->a( { -href => "http://validator.w3.org/check?uri=referer" },
		       "XHTML" ), " generated with ",
		$q->a( { -href => "http://www.ramiro.org/" }, "digicam2web.pl" )
		);
$HTML .= $q->end_html;

open(OUT, ">", "index.html");
print OUT $HTML;
close OUT;

# sub for reading the image files in the working dir
sub pictures {
   my $dir = shift;
   my $dh = DirHandle->new($dir) or die "can't opendir $dir: $!";
   return 
       grep { -B }
       map { if (/\.(?:jpe?g|png)$/i) { $_ } }
       $dh->read();
}