#!/usr/bin/perl use warnings; use strict; use MIME::Base64; use Image::Resize; use Tk; use Tk::JPEG; use Image::EXIF; die "usage: $0 250x169xmin 768x250xmed\n \tEg Width x High x Descr. Third element can be omitted (the description) and Width x High string will be used.\n\n" unless (defined $ARGV[0] and $ARGV[0] =~ /\d+x\d+/); my @files = glob('*.jpg'); print "\nFound ".scalar @files." files\n\n"; exit if scalar @files == 0; my @size_descr = map { [split 'x', $_] }@ARGV; my $x = 640; my $y = 480; my $mx = $x; my $my = $y + 200; my $mw = new MainWindow (); $mw -> geometry ($mx.'x'.$my); $mw->optionAdd('*font', 'Courier 12'); my $c = $mw->Canvas; $c->pack(-expand => 1, -fill => 'both'); my $cur_file = shift @files; print "Considering $cur_file\n"; my $exif = &get_exif($cur_file); my $gd = &phres($cur_file,$x,$y); my $image = $c->Photo( -data=> MIME::Base64::encode( $gd )); $c->createImage($x/2 , $y/2, -image => $image); my $label_exif_txt = "Exif info\n". "size: ".($$exif{width} ? $$exif{width} : 'undef' ). " x ".( $$exif{height} ? $$exif{height} :'undef' )."\n". "date: ". ($$exif{date} ? $$exif{date} : 'undef'); my $label_exif =$mw->Label( -justify => 'left', -background => 'black',-foreground => 'chartreuse1', -textvariable => \$label_exif_txt )->pack; my $label =$mw->Label(-text=> 'Insert a new name for the photo above.'."\n". 'The name will be added with the infix specified in command line'."\n". 'Then hit or the button below.')->pack() ; my $button_skip = $mw->Button(-borderwidth => 2,-relief => 'solid',-text => 'Skip this image', -command => \&next_pic)->pack; my $newname; my $entry = $mw->Entry( -width => 100,-borderwidth => 4, -textvariable => \$newname)->pack; $entry->bind('' => \&elaborate); $entry->focus; my $button = $mw->Button(-borderwidth => 2,-relief => 'solid',-text => 'Create resized and renamed images', -command => \&elaborate)->pack; $mw->MainLoop; ################################################################################ sub next_pic { $cur_file = shift @files; unless ($cur_file){ print "\nThe End\n"; $c->destroy; $label->destroy; $label_exif->destroy; $button_skip->destroy; $entry->destroy; $button->destroy; $mw->Label(-text=>"The End\nwill happen in 3 seconds..")->pack() ; $mw->update; sleep 3; exit 0; } print "Considering $cur_file\n"; $gd = &phres($cur_file,$x,$y); my $enc = MIME::Base64::encode($gd); $image->blank; $image= $c->Photo( -data=>$enc); $c->createImage($x/2 , $y/2,-image => $image ); $exif = &get_exif($cur_file); $label_exif_txt = "Exif info\n". "size: ".($$exif{width} ? $$exif{width} : 'undef' ). " x ".( $$exif{height} ? $$exif{height} :'undef' )."\n". "date: ". ($$exif{date} ? $$exif{date} : 'undef'); $entry->delete(0, 'end'); $mw->update; select(undef, undef, undef, .1); } ################################################################################ sub elaborate{ $newname = $entry->get(); ######################################### foreach my $res ( @size_descr ) { my $gd = &phres($cur_file,$$res[0], $$res[1]); &write_resized ($newname."_".(defined $$res[2] ? $$res[2] : "$$res[0]x$$res[1]" )."_".'.jpg',$gd); } ######################################### &next_pic; } ################################################################################ sub phres { my ($file, $x, $y) = @_; my $image_orig = Image::Resize->new($file, $x, $y); my $gd = $image_orig->resize($x, $y); return $gd->jpeg(); } ################################################################################ sub write_resized{ my ($name, $data) = @_; open(FH, '>', $name) or warn "Cannot write to $name! "; binmode FH; print FH $data; close(FH); print "\tOK: wrote $name\n"; } ################################################################################ sub get_exif { my $file = shift; my $exif = Image::EXIF->new($file); my %exif_img = %{$exif->get_image_info()|| {} }; my %exif = ( width => $exif_img{'Image Width'}, height=> $exif_img{'Image Height'}, date => $exif_img{'Image Created'}, ); return \%exif; } __END__