Album

 view release on metacpan or  search on metacpan

META.yml  view on Meta::CPAN

# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
name:         Album
version:      1.06
version_from: script/album
installdirs:  site
requires:
    File::Spec:                    0
    Getopt::Long:                  2.1
    Image::Info:                   1.16
    Image::Magick:                 6

distribution_type: module
generated_by: ExtUtils::MakeMaker version 6.30

Makefile.PL  view on Meta::CPAN

WriteMakefile
  (
   NAME         => ucfirst($scripts[0]),
   VERSION_FROM => "script/$scripts[0]",
   ($] >= 5.005) ?
   ( AUTHOR	=> 'Johan Vromans (jvromans@squirrel.nl)',
     ABSTRACT	=> 'Creates HTML based photo albums' ) : (),
   PREREQ_PM	=> { 'Getopt::Long' => 2.1,
		     'Image::Info' => 1.16,
		     'Image::Magick' => 6,
		     'File::Spec' => 0,
		   },
   EXE_FILES    => [ map { "script/$_" } @scripts ],
 );

sub checkexec {
    my ($exec) = @_;
    my $path = findbin($exec);
    if ( $path ) {
	print STDERR ("\t      Good, found $path\n");

lib/Album.pm  view on Meta::CPAN

=item *

File::Spec (Standard part of perl 5.8)

=item *

Image::Info

=item *

Image::Magick (PerlMagick). Of course, this requires an ImageMagick
install as well.

=back

The following tools / packages will be used if available:

=over 4

=item *

script/album  view on Meta::CPAN

my $prog_mplayer   = findexec("mplayer");
my $prog_mencoder  = findexec("mencoder");

################ The Process ################

use File::Spec;
use File::Path;
use File::Basename;
use Time::Local;
use Image::Info;
use Image::Magick;
use Data::Dumper;
use POSIX qw(locale_h strftime);
use locale;

# The files already there, if any.
my $gotlist = new FileList;
# The files in the import dir, if any.
my $implist = new FileList;

# The list of files, in the order to be processed.

script/album  view on Meta::CPAN

	}

	print STDERR (@_);
    };

    my $image;
    my $i_large;

    my $readimage = sub {
	my ($file) = (@_, $i_large);
	$image = new Image::Magick;
	my $t = $image->Read($file);
	warn("read($file): $t\n") if $t;
	#$image->Profile(name => "*", profile => undef);
    };

    my $resize = sub {
	 my ($n) = @_;
	 my ($origx, $origy) = $image->Get(qw(width height));
	 my $ratio = $origx > $origy ? $origx / $n : $origy / $n;
	 my $t = $image->Resize(width => $origx/$ratio, height => $origy/$ratio);

script/album  view on Meta::CPAN

		if ( ($el->file_ext || "") eq "jpg" && $prog_jpegtran ) {
		    my $cmd = "$prog_jpegtran -copy all -rotate " . $el->rotation . " ";
		    $cmd .= $el->mirror eq 'h' ? "-transpose " : "-transverse "
		      if $el->mirror;
		    $cmd .= "-outfile " . squote($i_large) .
		      " " . squote($i_src);
		    my $t = `$cmd 2>&1`;
		    $msg->($t) if $t;
		    utime($time, $time, $i_large);
		}
		# Otherwise, let Image::Magick handle it.
		else {
		    $readimage->($i_src);
		    $image->Rotate();
		    if ( $el->mirror ) {
			$image->Flip if $el->mirror eq 'h';
			$image->Flop if $el->mirror eq 'v';
		    }
		    my $t = $image->Write($i_large);
		    $msg->($t) if $t;
		    utime($time, $time, $i_large);

script/album  view on Meta::CPAN

    my $res = `$cmd 2>&1`;
    die("${res}Aborted\n") if $?;

    utime($time, $time, $new);
}

sub still {
    my ($el) = @_;

    my $new = d_large($el->assoc_name);
    my $still = new Image::Magick;
    if ( $prog_mplayer ) {
	my $tmp = "00000001.jpg";
	my $tmp2 = "00000002.jpg";
	if ( -e $tmp ) {
	    die("ERROR: mplayer needs to create a file $tmp, but it already exists!\n");
	}
	# Sometimes, -frames 1 does not produce anything. Need -frames 2.
	my $cmd = "$prog_mplayer -really-quiet -nojoystick -nolirc -nosound -frames 2 -vo jpeg " .
	  squote(d_large($el->dest_name));
	warn("\n+ $cmd\n") if $verbose > 2;

script/album  view on Meta::CPAN

	return $still;
    }
    # Scale to 640x480 if needed.
    my $r = $hs > $ws ? 640 / $hs : 640 / $ws;
    if ( abs($r - 1) > 0.05 ) {
	$still->Resize(width => $r*$ws, height => $r*$hs);
	($hs, $ws) = $still->Get(qw(height width));
    }

    # Create black canvas.
    my $canvas = new Image::Magick;
    $canvas->Set(size => ($ws+240).'x'.($hs+180));
    $canvas->ReadImage('xc:black');
    my ($hc, $wc) = $canvas->Get(qw(height width));

    # Place the still on top of it.
    # Center image
    $canvas->Composite(image => $still, compose => 'Atop', x => 120, 'y' => 90);
    # Bottom slice.
    $canvas->Composite(image => $still, compose => 'Atop', x => 120, 'y' => $hs+135);
    # Top slice. Cannot place at negative offsets, so crop the still first.
    $still->Crop(width => $ws, height => 45, x => 0, 'y' => $hs-45);
    $canvas->Composite(image => $still, compose => 'Atop', x => 120, 'y' => 0);
    undef $still;

    # Drill spocket holes.
    my $hole = new Image::Magick;
    $hole->Set(size => '60x40');
    $hole->ReadImage("xc:grey90");
    $hole->Draw(primitive => 'polygon', fill => "black",
		points => " 0,0   5,0   0,5");
    $hole->Draw(primitive => 'polygon', fill => "black",
		points => "60,0  55,0  60,5");
    $hole->Draw(primitive => 'polygon', fill => "black",
		points => "60,40 55,40 60,35");
    $hole->Draw(primitive => 'polygon', fill => "black",
		points => " 0,40  5,40  0,35");

script/album  view on Meta::CPAN

    my $iconfile = "icon.jpg";
    my $ii = cache_entry(" indexicon ");
    if ( -f $iconfile && $ii && $ii->dest_name eq "@imgs" ) {
	return 0;
    }
    my $el = new ImageInfo($iconfile);
    $el->dest_name("@imgs");
    cache_entry(" indexicon ", $el);
    $cache_update++;

    my $image = new Image::Magick->new;
    foreach ( @imgs ) {
	$image->Read($_);
    }

    my $width = $thumb;
    my $height = int($thumb*0.75);

    $image = $image->Montage(tile=>"${index_columns}x${index_rows}",
			     texture=>"xc:gray90");
    $image->Resize(geometry=>"${width}x${height}");