advertisement

Simple Photo Processing and Web Display with Perl

50 %
50 %
advertisement
Information about Simple Photo Processing and Web Display with Perl

Published on January 23, 2008

Author: kcowgill

Source: slideshare.net

Description

I have a small photo gallery on my website and in this presentation, I share
some steps I used in creating a nearly automatic workflow of getting
pictures from my camera to his gallery using Perl.
advertisement

Simple Photo Processing and Web Display with Perl Kent Cowgill

Unfortunately, nothing super fancy.

The first camera I used

The pictures were ... ok

The phone stayed in my pocket. Along with pocket lint. A lot of pocket lint.

And a lot of lint got in the lens

And the pictures started in the blurry And a lot of lint got getting lens

Especially with all my daily activities.

Especially with all my daily activities.

And the pictures got blurrier

... and blurrier ...

And practically unrecognizable.

So I got a new phone.

This has been my camera

The pictures were better

No lint problem, even in harsh conditions

Until my phone dropped out of my pocket and was picked up by Ricardo Signes at YAPC

But that blurriness was user error.

Thankfully, he returned my phone to me.

What a nice guy.

My RAZR has served me well.

Until Recently

More on that later.

Step 1: Get the picture from the phone to the server.

This is what I looked like

Taking pictures with my RAZR

The obligatory cat

www.kentcowgill.org

Step 2: Get the picture from the email to the filesystem.

strip image from mail cowgill motorola v551 2/9/05 1

use MIME::Parser; use MIME::Entity; use MIME::Base64 qw(decode_base64); use Image::Magick::Thumbnail;

my $parser = MIME::Parser->new(); $parser->output_dir( '/www/kentcowgill/photos/data' ); my $message = $parser->parse( *STDIN ) };

DFS? for my $part( $message->parts_DFS ){ if( $part->bodyhandle ){ if( $part->mime_type eq 'image/jpeg' ){ $filename = $part->bodyhandle->path; $data .= $part->as_string; $data =~ s/.*nn(.*)/$1/ms; } Ew. $data = decode_base64($data); ...

... open ARCHIVE, '>', $archive_image; binmode ARCHIVE; Error checking print ARCHIVE $data; is left as an exercise close ARCHIVE; for the reader. my $src = new Image::Magick; $src->Read($archive_image); ...

... my( $thumb, $x, $y ) =Image::Magick::Thumbnail::create( $src, 64 ); $thumb->Write($archive_thumb); } }

Worked great.

Flawlessly.

For a while.

Until I upgraded... Perl Image::Magick And with all their dependencies... God only knows what else.

WTF?

Then something broke. WTF?

It didn't make thisbroke. Then something blurry. WTF?

No, thatsomething broke. Then make this blurry. It didn'twas poor technique. WTF?

No, thatsomethingmy photos. It started make off broke. Then cutting this blurry. It didn'twas poor technique. WTF?

It was really annoying. WTF?

And inconsistent. WTF?

Cockroaches Termites (Not to scale) Bunnies (Also not to scale)

Tough to reliably reproduce.

So I spent my time and energy elsewhere.

Step 3: Get the picture from the filesystem to the web browser.

This is the site that I made

To view the pictures that I took

Click on a thumbnail...

And see the full image.

But not that one. ;-)

<?php $start = $_GET[quot;startquot;] ? $_GET[quot;startquot;] : quot;0quot;; $filearray = array(); $dir = quot;/www/kentcowgill/photos/archquot;; $mydir = quot;/photos/archquot;; $thumbdir = quot;/photos/thumbsquot;; if( $handle = opendir( $dir ) ){ while( false !== ( $file = readdir( $handle ) ) ){ if( $file != quot;.quot; && $file != quot;..quot;){ array_push( $filearray, $file ); } } closedir( $handle ); } ...

PHP?

Didn't I say Perl at the beginning?

$_ == 0 && do { $table .= quot;<tr><td align=center height=$CELLHEIGHT quot; . quot;width=$CELLWIDTH valign=bottom>quot;; last SWITCH; }

$_ == 0 && do { $table .= quot;<tr><td align=center height=$CELLHEIGHT quot; . quot;width=$CELLWIDTH valign=bottom>quot;; last SWITCH; } My only excuse is that I wrote it a really long time ago

:-p~

The picture viewer was updated as well.

I also got a dog. Cat Dog

And I stored the users' preferences...

User Preferences

Step 4: Fix the image stripping bug.

strip image from mail cowgill motorola RAZR v3 7/25/06 2

Add module version requirements.

use MIME::Parser; use MIME::Entity; use MIME::Base64 qw(decode_base64); use Image::Magick::Thumbnail;

use MIME::Parser 5.415; use MIME::Entity 5.415; use MIME::Base64 3.07 qw(decode_base64); use Image::Magick::Thumbnail;

Add debugging and logging.

my $parser = MIME::Parser->new(); $parser->output_dir( '/www/kentcowgill/photos/data' ); my $message = $parser->parse( *STDIN ) };

my $parser = MIME::Parser->new(); $parser->output_to_core(1); $parser->output_dir( '/www/kentcowgill/photos/data' ); my $message; eval { $message = $parser->parse( *STDIN ) }; if( $@ ){ my $results = $parser->results; open ERR, '>', '/www/kentcowgill/photos/err.txt'; print ERR $results; Additional error close ERR; } checking is left as an exercise for the reader.

for my $part( $message->parts_DFS ){ if( $part->bodyhandle ){ if( $part->mime_type eq 'image/jpeg' ){ $filename = $part->bodyhandle->path; $data .= $part->as_string; $data =~ s/.*nn(.*)/$1/ms; } $data = decode_base64($data); ...

for my $part( $message->parts_DFS ){ if( $part->bodyhandle ){ if( $part->mime_type eq 'image/jpeg' ){ $filename = $part->bodyhandle->path; $data .= $part->as_string; print LOG2 $data; print LOG3 $filename; my @raw_part = split( /n/, $data ); my @edited_part; for my $line( @raw_part ){ if( $line =~ m/^$/ ){ $found++; next; } next unless $found; push @edited_part, $line; } $data =~ s/.*nn(.*)/$1/ms; $data = join( quot;nquot;, @edited_part ); print LOG $data; } $data = decode_base64($data);

... my $src = new Image::Magick; $src->Read($archive_image); ...

... my $src = new Image::Magick; my $debug = $src->Read($archive_image); print LOG quot;WARNING: ImageMagick::Read quot; . quot;had problem: $debugnquot; if $debug; ...

... my( $thumb, $x, $y ) =Image::Magick::Thumbnail::create( $src, 64 ); $thumb->Write($archive_thumb); } }

No debugging here. ... my( $thumb, $x, $y ) =Image::Magick::Thumbnail::create( $src, 64 ); $thumb->Write($archive_thumb); } }

No problem with thumbnails.  The cut-off images scaled fine.

The result?

No hints.

No clues.

No fix.

:-(

Step 5: Replace the image stripping program.

strip image from mail cowgill motorola RAZR v3 1/5/07 3

Replace the modules used.

use MIME::Parser 5.415; use MIME::Entity 5.415; use MIME::Base64 3.07 qw(decode_base64); use Image::Magick::Thumbnail;

use Email::MIME; use Email::MIME::Attachment::Stripper; use MIME::Base64 qw(decode_base64); use Imager; Still Used

my $parser = MIME::Parser->new(); $parser->output_to_core(1); $parser->output_dir( '/www/kentcowgill/photos/data' ); my $message; eval { $message = $parser->parse( *STDIN ) }; if( $@ ){ my $results = $parser->results; open ERR, '>', '/www/kentcowgill/photos/err.txt'; print ERR $results; close ERR; }

for my $part( $message->parts_DFS ){ if( $part->bodyhandle ){ if( $part->mime_type eq 'image/jpeg' ){ $filename = $part->bodyhandle->path; $data .= $part->as_string; print LOG2 $data; print LOG3 $filename; my @raw_part = split( /n/, $data ); my @edited_part; for my $line( @raw_part ){ if( $line =~ m/^$/ ){ $found++; next; } next unless $found; push @edited_part, $line; } $data =~ s/.*nn(.*)/$1/ms; $data = join( quot;nquot;, @edited_part ); print LOG $data; } $data = decode_base64($data);

my $email = Email::MIME->new( $msg_text ); my $stripper = Email::MIME::Attachment::Stripper->new( $email ); my @files = $stripper->attachments; @files = grep { $_->{content_type} eq 'image/jpeg' } @files; my $image_data = @files ? $files[0]->{payload} : decode_base64( $email->{parts}[0]->{body} );

... my $src = new Image::Magick; my $debug = $src->Read($archive_image); print LOG quot;WARNING: ImageMagick::Read quot; . quot;had problem: $debugnquot; if $debug; ...

my $src = Imager->new; $src->read( file => $archive_image, type => 'jpeg' );

... my( $thumb, $x, $y ) =Image::Magick::Thumbnail::create( $src, 64 ); $thumb->Write($archive_thumb); } }

my $tmbimg = $src->copy(); my $thumb = $tmbimg->scale( xpixels => 64, ypixels => 48, type => 'min' ); $thumb->write( file => $archive_thumb );

The result?

OMG!! IT WORKS!@$!

No one was happier than my dog.

Step 6: Add display options.

When was the picture taken?

The pictures arrive at my server within minutes.

[~]$ perldoc -f time time Returns the number of non-leap seconds since whatever time the system considers to be the epoch, suitable for feeding to quot;gmtimequot; and quot;localtimequot;.

my $archivedir = '/www/kentcowgill/photos/arch'; my $thumbdir = '/www/kentcowgill/photos/thumbs'; my $pic_time = time; my $archive_image = $archivedir . '/' . $pic_time . '.jpg'; my $archive_thumb = $thumbdir . '/' . $pic_time .'_thumb.jpg';

sub pretty_date { my( $stamp ) = shift; # $stamp = 1195004723; my @date = split /s+/, scalar localtime $stamp; # @date = qw(Tue Nov 13 19:45:23 2007); my $date = join q{ }, splice @date, 1, 5; # $date = 'Nov 13 19:45:23 2007'; my ( $hr, $mn ) = ( split /:/, ( split /s+/, $date)[2] )[0,1]; # $hr = 19; $mn = 45; my $merid = $hr > 12 ? do { $hr -= 12; 'pm' } : $hr == 12 ? 'pm' : 'am'; # $hr = 7; $merid = 'pm'; $date =~ s/(w+) (d+) .* (d+)/$1 $2, $3: $hr:$mn$merid/; # $date = 'Nov 13, 2007: 7:45pm'; return $date; }

SIDE BAR my $merid = $hr > 12 ? do { $hr -= 12; 'pm' } : $hr == 12 ? 'pm' : 'am'; # $hr = 7; $merid = 'pm'; Concise and efficient? OR Obfuscation?

SIDE BAR <australian accent> That's not an obfuscation... <australian accent>

$_='`$t` `.=lc for<>;u($_` )for` 3..``6;%t=qw ` `(a 82 b 15 c 28 d 43 e ` `127 f 22 ` g 20 h 61 i 70 ` `j 2 k 8 ```````l 40 m 24 n 67 ` o 75` ` p 19 q 1` `r` 60 s 63 t ` 91 ` u 28 v 1 `0 w ` 24 x 2 y ` `20 ` ` z 1);$k= k() ` ``;$d+=$t{$` `_}f o``r keys%t;$l =$d` /in` ``t(`length($t)/ $k)/100 ` ;map{%n=f(t($_));@g=b(1,` `%n);$y.= i(@g)}0..$k-1;@_=(a..z); map{@$_= @_;if($;++){for$quot;(2..$;){ pu ` sh` `` @$_,shift@$_} `` `` `}` }@_;map{$p=i` n` d`ex `((join'',` ` ` `@`{(sp `lit//,$y)[$c ` ]}),$_);` `$o```.=$p>=0?$`a` `` [ $p]: $_;$c+=$c<$k-1?1 ````: `-$` ``k+1}split//,$t;s ``ub 'b{my($e,$s `,@g)=@_;p ` ``ush@ `g`,[$_,(s pli` `` ``t//,'#' ``x in` `` `t($$s{`$_}*$e )`)]for ` `+sort+keys%$s;retur ```n@g}s` ub'c{my$x=shift;$x=g($x,shift ```)while@_; return$x}sub'f{my%d;$d{$_}++f` or grep/[a-z]/ ,split//,shift;$d{$_}||=0for a..z;return%d}su b'g{my($x,$y)=@_;($x,$y)=($y,$x%$y)while$y;r eturn$x}sub'i{my($g,@c)=@_;map{push@c,o(v($g),` `` ` $$g[0][0]);w($g)}0..25;return(map{$_->[1]}sort{$` b-`` >[0]<=>$a->[0]}@c)[0]} sub'k{my@g;for(sort{$s{` `$b}`` <=>$s{$a}}keys%s){last ``if$s{$_}<3;next unless y `/a-``` z//>2;my@f ;push@f,(pos `($t)-3)while$t=~/$_/g;m` ````````y$g=c(n(@f) );`$g```` >2&&push@g,$g}return c(@` g)}sub'n{my$o= shift;return map{$_-$o}@_ }sub'o{my($g,$w) =@_;my$c=0;map{map{/+/&&` $c++;/-/&&$c--}@ $_}@$g;return[$c,$w]}sub' `t{my($o)=@_;my$c= 0;my$r;map{$r.=$_ unless( `$k-$o+$c)%$k;$c++} split//,$t;$r=~s/[^a-z]/ /g;return$r}sub'u{ my$l=$_[0];$s{substr($t` ,$_,$l)}++for 0..(le ngth($t)-$l)}sub'v{my($ `m)=@_;my@g=b($l,%t );$s=@g;$z=0;map{$x=0;ma `p{$$s[$z][$x]=$$m` [$z][$x]eq'#'&&$$s[$z][ `$x]eq'#'?'+` ':'-';$x++}@$_;$z++}@$m `;return$s}sub 'w{$R=shift;push@$R,shif` `t@$R}printquot; Key: $ynPlaintext:n$o`` `nquot;;';s-s s+--gmx;s&`&&gm;eval#;` #etur#`` `#my($x($v());$y=$z#`#` ##```` ``# charles #`` #`````` ````# babbage #`

$_='`$t` `.=lc for<>;u($_` )for` 3..``6;%t=qw ` `(a 82 b 15 c 28 d 43 e ` `127 f 22 ` g 20 h 61 i 70 ` `j 2 k 8 ```````l 40 m 24 n 67 ` o 75` ` p 19 q 1` `r` 60 s 63 t ` 91 ` u 28 v 1 `0 w ` 24 x 2 y ` `20 ` ` z 1);$k= k() ` ``;$d+=$t{$` `_}f o``r keys%t;$l =$d` /in` ``t(`length($t)/ $k)/100 ` ;map{%n=f(t($_));@g=b(1,` `%n);$y.= i(@g)}0..$k-1;@_=(a..z); map{@$_= @_;if($;++){for$quot;(2..$;){ pu ` sh` `` @$_,shift@$_} `` `` `}` }@_;map{$p=i` n` d`ex `((join'',` ` ` `@`{(sp `lit//,$y)[$c ` ]}),$_);` `$o```.=$p>=0?$`a` `` [ $p]: $_;$c+=$c<$k-1?1 ````: `-$` ``k+1}split//,$t;s ``ub 'b{my($e,$s `,@g)=@_;p ` ``ush@ `g`,[$_,(s pli` `` ``t//,'#' ``x in` `` `t($$s{`$_}*$e )`)]for ` `+sort+keys%$s;retur ```n@g}s` ub'c{my$x=shift;$x=g($x,shift ```)while@_; return$x}sub'f{my%d;$d{$_}++f` or grep/[a-z]/ ,split//,shift;$d{$_}||=0for a..z;return%d}su b'g{my($x,$y)=@_;($x,$y)=($y,$x%$y)while$y;r eturn$x}sub'i{my($g,@c)=@_;map{push@c,o(v($g),` `` ` $$g[0][0]);w($g)}0..25;return(map{$_->[1]}sort{$` b-`` >[0]<=>$a->[0]}@c)[0]} sub'k{my@g;for(sort{$s{` `$b}`` <=>$s{$a}}keys%s){last ``if$s{$_}<3;next unless y `/a-``` z//>2;my@f ;push@f,(pos `($t)-3)while$t=~/$_/g;m` ````````y$g=c(n(@f) );`$g```` >2&&push@g,$g}return c(@` g)}sub'n{my$o= shift;return map{$_-$o}@_ }sub'o{my($g,$w) =@_;my$c=0;map{map{/+/&&` $c++;/-/&&$c--}@ $_}@$g;return[$c,$w]}sub' `t{my($o)=@_;my$c= 0;my$r;map{$r.=$_ unless( `$k-$o+$c)%$k;$c++} split//,$t;$r=~s/[^a-z]/ /g;return$r}sub'u{ my$l=$_[0];$s{substr($t` ,$_,$l)}++for 0..(le ngth($t)-$l)}sub'v{my($ `m)=@_;my@g=b($l,%t );$s=@g;$z=0;map{$x=0;ma `p{$$s[$z][$x]=$$m` [$z][$x]eq'#'&&$$s[$z][ `$x]eq'#'?'+` ':'-';$x++}@$_;$z++}@$m `;return$s}sub 'w{$R=shift;push@$R,shif` `t@$R}printquot; Key: $ynPlaintext:n$o`` `nquot;;';s-s s+--gmx;s&`&&gm;eval#;` #etur#`` `#my($x($v());$y=$z#`#` ##```` ``# charles #`` #`````` ````# babbage #`

Or with Date::Calc: use Date::Calc qw( Today Month_to_Text Localtime ); my $datestamp = shift; my( $year, $month, $day, $hour, $minute ) = ( Localtime( $datestamp ) )[ 0 .. 4 ]; my $meridian = $hour > 12 ? do { $hour -= 12; 'pm' } : $hour == 12 ? 'pm' : 'am'; my $date = sprintf( '%.3s %02d, %d: %d:%d%s', Month_to_Text( $month ), $day, $year, $hour, $minute, $meridian, ); # $date = 'Nov 13, 2007: 7:45pm';

Or with a regex: Believe it use strict; or not use warnings; my $date = scalar localtime $stamp; $date =~ s{^w{3}s(w{3} )(?{$^N})s+(d+)(?{$,=$^R.$quot;. $^N})s(d+)(?{$.=$^N;$@=$.>12?do{$.-=12;'pm' }:$ .==12?'pm':'am'}):( d+)(?{$ /=quot;$ .:$ ^N$ @quot;}):d+s(d{4})(?{$==$ ^N})}{$,$quot;$=:$quot;$/}x; # $date = 'Nov 13, 2007: 7:45pm';

Adding captions to the photos.

Use a database.

create database photoblog; use photoblog; create table captions ( caption_id int( 11 ) not null auto_increment, caption_photo varchar( 32 ) not null, caption_text text, primary key( caption_id ), unique caption_id( caption_id ) );

Create a row in the database when an email arrives.

Why? • Makes later CRUD implementation easier.

CRUD The four basic functions of persistent storage. Create Retrieve Update Delete

Why? • Makes later CRUD implementation easier. • In the editing interface, just implement: • Retrieve and Update • Don't worry about Create • Delete is just updating a record to nothing.

What is CRUD without the Create and Delete? CRUD

RU

IN SOVIET RUSSIA CRUD WRITES YOU!

my $dbh = Mysql->connect( 'localhost', 'photoblog', $username, $password, ); my $sth = $dbh->query( qq{ insert into captions (caption_photo) values ('$new_filename')} ); Bindinginput parameters is left $sth->finish; as an exercise for the reader.

Create an interface to update captions.

my $caption = param( 'caption' ); my $url = param( 'url' ); Binding the $url =~ m/.*/(.*).jpg/; input parameter my $picture = $1; would've helped here. $caption =~ s/'/''/g; $caption =~ s/<.*?>//g; Just stripping out HTML tags. my $dbh = Mysql->connect( 'localhost', 'photoblog', $username, $password, ); my $query = qq{ update captions set caption_text='$caption' where caption_photo='$picture'}; my $sth = $dbh->query( $query );

Fetch the captions when showing the thumbnails.

my $query = qq{ select caption_text from captions where caption_photo=$picbase}; my $dbh = Mysql->connect( 'localhost', 'photoblog', $username, $password, ); my $sth = $dbh->query( $query ); my $caption = $sth->fetchrow; $caption = $caption || '';

Step 7: Redesign.

Fit into the design for the rest of the site

($header=<<quot; EOHEADERquot;) =~ s/ //gm; <!DOCTYPE HTML PUBLIC quot;-//W3C//DTD HTML 4.01 Transitional//ENquot; quot;http://www.w3.org/TR/html4/loose.dtdquot;> <html> <head><title>$title</title> <style type=quot;text/cssquot;> EOHEADER ... SWITCH: for( $counter ){ $_ == 0 && do { $table .= quot;<tr><td align=quot;centerquot; quot; . quot;valign=quot;bottomquot;>nquot;; last SWITCH; }; $_ == ($cols) && do { $table .= quot;</tr>nquot;; last SWITCH; }; $table .= qq(<td align=quot;centerquot; valign=quot;bottomquot;>n); }

Templates++

use Template; ... my %pic = ( picture => q{/photos/arch/} . $base . '.jpg', timestamp => pretty_date( $base ), thumb => q{/photos/thumbs/} . $base . q{_thumb.jpg}, caption => $caption, );

<table border=quot;0quot; class=quot;galleryquot;> [% FOREACH row IN pictures -%] <tr> [% FOREACH pic IN row -%] <td align=quot;centerquot; valign=quot;bottomquot; class=quot;picquot;> <a href=quot;javascript:OpenWindow('[% pic.picture %]','700','540')quot;><img src =quot;[% pic.thumb %]quot; alt =quot;[% pic.caption %]quot; title =quot;[% pic.caption %]quot;/></a> <p class=quot;timestampquot;>[% pic.timestamp %]</p> </td> [% END -%] </tr> [% END -%] </table>

Add a quot;current imagequot;. i.e. most recently taken

my $src = Imager->new; $src->read( file => $archive_image, type => 'jpeg' ); my $newimg = $src->copy(); my $curimg = $newimg->scale( xpixels => 320, ypixels => 240, type => 'min', ); my $gryimg = $curimg->convert( preset => 'grey' ); $gryimg->write( file => $current_image );

my ( $firstbase ) = $firstfile =~ m{^.+/(d+).jpg$}; $vars->{ mostrecent } = get_caption( $firstbase ); $vars->{ randomizer } .= int rand 9 for 1 .. 8;

Why? • Browsers cache the image • appending a random number (i.e. quot;?12345678quot;) prevents caching • It's an actual image, but it could be a CGI • It could be dynamically generated • Your web browser and my server won't know the difference • No caching, fresh request each time

[% IF mostrecent -%] <table border=quot;0quot; class=quot;mostrecentquot;> <tr><td class=quot;mostrecentquot;> <img src=quot;/photos/mostrecent.jpg?[% randomizer %]quot;/> </td></tr> </table> [% END -%]

Use it elsewhere.

Organize the photos.

Why? • Having a chronological list is OK • By assigning tags to photos, you won't have to remember which page of 60 has: • that picture of the dog from 3 months ago • the picture of the bed you bought last year • or...

The picture of the video chat with your crazy in-laws.

Use the same database.

use photoblog; create table tags ( tag_id int( 11 ) not null auto_increment, tag_photo varchar( 32 ) not null, tag_name text, primary key( tag_id ), unique tag_id( tag_id ) );

Create an interface to add tags.

my $tags = param( 'tags' ); my @tags = split( /(?:s+|,)/, $tags ); my $dbh = Mysql->connect( quot;localhostquot;, quot;photoblogquot;, $username, $password ); my $delete = qq{ delete from tags where tag_photo = '$picture'}; $sth = $dbh->query( $delete ); for my $tag( @tags ){ my $ins = qq{ insert into tags( tag_photo, tag_name ) values( '$picture', '$tag' )}; $sth = $dbh->query( $ins ); }

Fetch the tags when showing the pictures.

my $query = q{ select tag_name from tags where tag_photo=$picbase}; $sth = $dbh->query( $query ); my @tags; while( my $tag = $sth->fetchrow ){ push @tags, $tag; } my $tags = join( ' ', @tags ); $tags ||= ''; $vars->{ tags } = [ $tags ];

Create a quot;tag cloudquot;.

$query = qq{ select count(*) as num, tag_name from tags group by tag_name having num > $MIN_TAGS }; $sth = $dbh->prepare( $query ); $sth->execute; my @tags; while( my $hashrow = $sth->fetchrow_hashref ){ push @tags, $hashrow } $vars->{ phototags } = [ @tags ];

<table style=quot;background: #ccc; border: 1px solid #555quot;> <tr><th align=quot;leftquot;>Photos filed under...</th></tr> <tr><td align=quot;centerquot;> [% FOREACH tag = phototags -%] <span style=quot;font-size: [% ( tag.num + 80 ) / 8 %]pxquot;> <a href=quot;/photos.cgi?tagged=[% tag.tag_name %]quot; title=quot;[% tag.num %] photo[% IF tag.num > 1 %]s[% END %] filed under [% tag.tag_name %]quot;>[% tag.tag_name %]</a> </span> Highly complicated [% END -%] and sophisticated formula derived by </td></tr></table> minutes and minutes of trial and error

Jazz it up with a little AJAX

AJAX (Asynchronous JavaScript and XML), or Ajax, is a group of inter-related web development techniques used for creating interactive web applications. A primary characteristic is the increased responsiveness and interactiveness of web pages achieved by exchanging small amounts of data with the server quot;behind the scenesquot; so that the entire web page does not have to be reloaded each time the user performs an action. This is intended to increase the web page's interactivity, speed, functionality, and usability. http://en.wikipedia.org/wiki/Ajax_(programming)

AJAX (Asynchronous JavaScript and XML)

AJ

AJ

http://jquery.com

Load JQuery in your template <script type = quot;text/javascriptquot; src = quot;/script/jquery.jsquot;></script> Right here

Create a Javascript Function to switch the pictures function swapem( pic ){ $('#caption').fadeOut( 'slow' ); $('#display').fadeOut( 'slow', function(){ getData( pic ); $('#display').html( '<img src=quot;' + pic + 'quot; border=quot;0quot;>'); $('#display').show; $('#display').fadeIn( 1500 ); Callback }); }

Callback A callback is executable code that is passed as an argument to other code. Because of the asynchronous nature of calls in the JQuery library, using certain code as callbacks helps ensure specific timing for events.

Create the AJAX request function getData( pic ){ $.ajax( { url : '/caption.cgi', Callback type : 'POST', dataType : 'html', data : 'pic=' + pic, success : function( retVal ){ $('#caption').html( retVal ); }, complete : function(){ $('#caption').fadeIn( 'slow' ); } }); } Callback

Call the AJAX code <td align=quot;centerquot; valign=quot;bottomquot; class=quot;picquot;> <a href=quot;javascript:swapem('[% pic.picture %]');quot;><img src =quot;[% pic.thumb %]quot; alt =quot;[% pic.caption %]quot; title =quot;[% pic.caption %]quot;/></a> <p class=quot;timestampquot;>[% pic.timestamp %]</p> </td> Right here

Create a CGI to handle the AJAX call #!/usr/bin/perl use strict; use warnings; use DBI; use CGI qw/:standard/; Saved a lot of copying use PhotoLib; and pasting ...

Damian said it best: • Place original code inline. • Place duplicated code in a subroutine. • Place duplicated subroutines in a module. - Perl Best Practices, page 401

Create a CGI to handle the AJAX call ... my $pic = param('pic') || exit; # $pic = '/photos/arch/1197770265.jpg'; $pic =~ s/[^d]+(d+)..*/$1/; # $pic = '1197770265'; my $caption = get_caption( $pic ); $caption =~ s/''/'/g; # stoopid mysql my @tags = get_tags( $pic ); ...

Create a CGI to handle the AJAX call ... my $out = header(); $out .= qq{<span style=quot;font-family: tahoma; }; $out .= qq{quot;><p>$caption</p><p>More pictures: }; for my $tag( @tags ){ $out .= qq{<a href=quot;photos.cgi?tagged=$tagquot;>$tag</a> }; } $out .= quot;</p>quot;; print $out; Should I have used a template?

Please visit http://www.kentcowgill.org/photos for the Ajax demonstration

Then something wonderful happened

8-D

The pictures arrive at my server within minutes.

www.kentcowgill.org

Why?

I got a real* camera * For some values of real.

My new camera stores images on one of these...

www.kentcowgill.org Also happens in batches Happens much later, all at once

They would all get the same timestamp: Nov 13, 2007: 8:15pm www.kentcowgill.org

What to do?

Read The Fine Manual

I want to keep the filename standard

I want to keep the filename standard I've already got over 700 images and their tags in my database

exif_date_time_original 2007:10:28 18:03:54 ≠ 1193612634

Time::Local(3) User Contributed Perl Documentation Time::Local(3) NAME Time::Local - efficiently compute time from local and GMT time SYNOPSIS $time = timelocal($sec,$min,$hour,$mday,$mon,$year); $time = timegm($sec,$min,$hour,$mday,$mon,$year); DESCRIPTION These routines are the inverse of built-in perl functions localtime() and gmtime(). They accept a date as a six-element array, and return the corresponding time(2) value in seconds since the system epoch (Mid- night, January 1, 1970 GMT on Unix, for example).

my $filebase = 'tempfilename'; my $archive_image = qq($arch_dir/${filebase}.jpg); # ... my $date_time = $src->tags( name => 'exif_date_time_original' ); my( $y, $mo, $d, $h, $m, $s ) = ( split /(?::| |T|-)/, $date_time )[ 0 .. 5 ]; $y -= 1900; $mo -= 1;

my $filebase = 'tempfilename'; my $archive_image = qq($arch_dir/${filebase}.jpg); # ... my $date_time = $src->tags( name => 'exif_date_time_original' ); my( $y, $mo, $d, $h, $m, $s ) = ( split /(?::| |T|-)/, $date_time )[ 0 .. 5 ]; $y -= 1900; $mo -= 1;

my $filebase = 'tempfilename'; my $archive_image = qq($arch_dir/${filebase}.jpg); # ... my $date_time = $src->tags( name => 'exif_date_time_original' ); my( $y, $mo, $d, $h, $m, $s ) = ( split /(?::| |T|-)/, $date_time )[ 0 .. 5 ]; $y -= 1900; $mo -= 1; my $new_filename = timelocal( $s, $m, $h, $d, $mo, $y ); my $new_image = qq($arch_dir/${new_filename}.jpg); rename $archive_image, $new_image;

my $filebase = 'tempfilename'; my $archive_image = qq($arch_dir/${filebase}.jpg); # ... my $date_time = $src->tags( name => 'exif_date_time_original' ); my( $y, $mo, $d, $h, $m, $s ) = ( split /(?::| |T|-)/, $date_time )[ 0 .. 5 ]; $y -= 1900; $mo -= 1; my $new_filename = timelocal( $s, $m, $h, $d, $mo, $y ); my $new_image = qq($arch_dir/${new_filename}.jpg); rename $archive_image, $new_image;

exif_date_time_original 2007:10:28 18:03:54

exif_date_time_original 2007:10:28 18:03:54 2007-10-28T18:03:54

=)

7.2 MEGA PIXELS 3,072px x 2,304px

1 2 3,072 pixels x 2,304 pixels 12,288 1 921,600 + 6,144,000 7,077,888 pixels

445 54 7,077,888 pixels x 16 bits per pixel 42,467,328 + 70,778,880 113,246,208 bits

113,246,208 bits 14,155,776 bytes 13,824 kilobytes 13.5 megabytes

TOO

BIG

Wouldn't it be great if I could get these 7 MP images automatically scaled to 640x480?

[Kent-Cowgills-Computer ~]$ locate Constrain /Applications/Adobe ImageReady CS/Samples/Droplets/ ImageReady Droplets/Constrain 350, Make JPG 30.exe /Applications/Adobe ImageReady CS/Samples/Droplets/ ImageReady Droplets/Constrain to 200x200 pixels.exe /Applications/Adobe ImageReady CS/Samples/Droplets/ ImageReady Droplets/Constrain to 64X64 pixels.exe /Applications/Adobe ImageReady CS/Samples/Droplets/ Photoshop Droplets/Constrain to 300 pixels.exe

Now for a tutorial on creating contextual menu droplets in... Adobe ImageReady™

Just kidding.

But that's not Perl.

No Perl ≠ Fun

Perl === Fun (wait - that's PHP)

Perl == Fun



Use Imager.pm to scale images to 640x480

my $src = Imager->new; $src->read( file => $archive_image, type => 'jpeg' ); my $newimg = $src->scale( xpixels => 640, ypixels => 480, type => 'min', qtype => 'mixing', ); $newimg->write( file => $new_name, type => 'jpeg', jpegquality => 85, );

What about when you rotate the camera?

Exif Orientation Tag Values Value 0th Row 0th Column 1 top left side 2 top right side 3 bottom right side 4 bottom left side 5 left side top 6 right side top 7 right side bottom 8 left side bottom

Here is what the letter F would look like if it were displayed by a program that ignores the orientation tag: 1 2 3 4 888888 888888 88 88 88 88 88 88 8888 8888 8888 8888 88 88 88 88 88 88 888888 888888 5 6 7 8 8888888888 88 88 8888888888 88 88 88 88 88 88 88 88 88 8888888888 8888888888 88 From: http://sylvana.net/jpegcrop/exif_orientation.html

8 8888888888 88 88 88

8 8888888888 88 88 88

8 8888888888 88 88 88

8 8888888888 88 88 88

my $src = Imager->new; $src->read( file => $archive_image, type => 'jpeg' ); my $orientation_tag = $src->tags( name => 'exif_orientation' ); my %degrees_for = ( 6 => 90, 8 => -90 ); my $newimg; if( exists $degrees_for{ $orientation_tag } ){ $src = $src->rotate( degrees => $degrees_for{ $orientation_tag } ); }





Wouldn't it be great if I could get these scaled photos automatically to my server?

Poker?

AWL MUH MUNNI ... DA POT HAZ IT

I've invested all that time with my image stripper for emails.

: A nr a l o P t a m o t u A

What's the problem?

1) Wasn't working right.

2) Wasn't Doing What I Mean (DWIM).

3) Wasn't Perl.

Automator ≠ Fun



: B n pt a l P cri S e l p p A

WTF?

What's the problem?

1) Tell who what now?

2) Repeat what with which in the where?

3) Dear God why can't I find an example.

4) Wasn't Perl.

AppleScript ≠ Fun



: C n pt a l P cri Sl er le pP p Am o r F

Yes! Perl!

Perl == Fun!

use Mac::AppleScript qw(RunAppleScript); ... sub send_email { my $scr; my $msg = shift; DEBUG quot;Attempting to send emailquot;; ($scr = <<quot; EOSquot;) =~ s/^s+//gm; set fromAcct to quot;$FROM_ACCOUNTquot; set toAcct to quot;$TO_ACCOUNTquot; tell application quot;Mailquot; repeat with acc in accounts if display name of acc is fromAcct then connect acc repeat with ctc in contacts of acc if display name of ctc is toAcct then send ctc message quot;$msgquot; on account acc end if end repeat disconnect acc end if end repeat end tell EOS RunAppleScript($scr) or DEBUG quot;couldn't run applescriptquot;; }

What's the problem?

1) I'm sorry, AppleScript is just a pain.

2) It's just a hunk of AppleScript crammed into Perl.

3) So basically, it wasn't Perl.

AppleScript, even when used from within Perl ≠ Fun

Are you thinking what I'm thinking?

Too bad I didn't think of it earlier. ( I really didn't! =:-o )

: D ne a it lL P :: E M I l! r Pe M 's It

opendir my $indir, $picdir or die quot;Can't open directory - $!quot;; send_img( $_ ) for grep { ! /^./ } readdir $indir; sub send_img { my $image = shift; my $file = quot;$picdir/$imagequot;; my $msg = MIME::Lite->new( From => 'kent@c2group.net', To => 'XXXXX@c2group.net', Subject => 'Here is my image', Type => 'multipart/mixed' ); $msg->attach( Type => 'image/jpeg', Encoding => 'base64', Path => $file, Filename => $image, Disposition => 'attachment' ); $msg->send( 'smtp', 'localhost:2025' ); my $new_loc = $file; Use your own SMTP $new_loc =~ s/send/sent/; server, not the SSH tunnel rename $file, $new_loc; on my computer :) }

Perl == Fun!

:-D

But now there's a new problem...

WTF?

8-[

The problem: No image (exif) tags

In the process of creating the scaled image, Imager didn't keep the exif tags.

It's a known limitation.

Some might call it a design decision.

I've invested all that time with my image stripper for emails.

(sound familiar?)

Tony Cook suggests: Image::ExifTool

use strict; use warnings; use Imager; use Image::ExifTool; my $src = Imager->new; $src->read( file => $file ); my $exif = new Image::ExifTool; my $info = $exif->SetNewValuesFromFile( $file ); $exif->SetNewValue( 'orientation' => 1, Type => 'ValueConv' ); ... $exif->WriteInfo( $new_file );

quot;So, that's great and all. But I use flickr.quot;

Need I say more?

=o]

So, in review, the process is...

Take the picture

Get the picture to the computer

Reorient and scale

Send it

Through the internet www.kentcowgill.org

Strip it from the email my $email = Email::MIME->new( $msg_text ); my $stripper = Email::MIME::Attachment::Stripper->new( $email ); my @files = $stripper->attachments; @files = grep { $_->{content_type} eq 'image/jpeg' } @files; my $image_data = @files ? $files[0]->{payload} : decode_base64( $email->{parts}[0]->{body} );

Make a thumbnail my $src = Imager->new; $src->read( file => $archive_image, type => 'jpeg' ); my $tmbimg = $src->copy(); my $thumb = $tmbimg->scale( xpixels => 64, ypixels => 48, type => 'min' ); $thumb->write( file => $archive_thumb );

Make a greyscale image my $curimg = $newimg->scale( xpixels => 320, ypixels => 240, type => 'min', ); my $gryimg = $curimg->convert( preset => 'grey' ); $gryimg->write( file => $current_image );

Add a caption my $dbh = Mysql->connect( 'localhost', 'photoblog', $username, $password, ); my $query = qq{ update captions set caption_text='$caption' where caption_photo='$picture'}; my $sth = $dbh->query( $query );

Add tags my $tags = param( 'tags' ); my @tags = split( /(?:s+|,)/, $tags ); for my $tag( @tags ){ my $ins = qq{ insert into tags( tag_photo, tag_name ) values( '$picture', '$tag' )quot;;}; $sth = $dbh->query( $ins ); }

Fetch the tags

Display the thumbnails

Show the picture

And that's it.

Thank you.

Any questions?

References •Chuck Norris' Action Jeans: http://www.denimology.co.uk/2006/09/chuck_norris_action_jeans.php •AJAX on Wikipedia: http://en.wikipedia.org/wiki/Ajax_(programming) •JQuery: http://jquery.com/ •Great quot;visualquot; jquery documentation: http://visualjquery.com/ •Exif Orientation information: http://sylvana.net/jpegcrop/exif_orientation.html •My photo gallery: http://www.kentcowgill.org/photos •My Flickr page: http://flickr.com/photos/kcowgill

Add a comment

Related pages

Simple Photo Processing and Web Display with Perl

Simple Photo Processing and Web Display with Perl. By Kent ... automatic workflow of getting pictures from my digital camera to my gallery using Perl. ...
Read more

Simple Photo Processing and Web Display with Perl

I have a small photo gallery on my website and in this presentation, I sharesome steps I used in creating a nearly automatic workflow of gettingpictures ...
Read more

How to display an image with Perl - Stack Overflow

How to display an image with Perl. ... so I need to read the image then display the image to the user to let the user reads ... Simple to fetch the image ...
Read more

Simple perl scripts - Technology - documents.mx

Some Simple Perl Scripts
To get an idea of how Perl works, ... Simple Photo Processing and Web Display with Perl. Give your little scripts big wings: ...
Read more

Schedule - YAPC::NA 2016

Schedule Register ... - ‎Simple Photo Processing and Web Display with Perl ... Welcome to the conference website for Yet Another Perl Conference ...
Read more

CGI Resource Index » Programs and Scripts » Perl » Image ...

CGI » Programs and Scripts » Perl » Image Display ... A simple tool for image processing. ... Display photo images on the top page of your site using SSI.
Read more

Image Display - CGI/PERL : Free Scripts - Script Library

Free scripts image display, cgi/perl. Buy image display, cgi/perl scripts like Simple Web ... online photo gallery. It contains a Perl ...
Read more

Photo Processing | LinkedIn

View 6251 Photo Processing posts, ... Photo/video processing. ... Simple Photo Processing and Web Display with Perl.
Read more

Easy PHP Image Photo Gallery Script Commercial Scripts CMS ...

Free Downloads of Easy PHP Image Photo Gallery Script. A simple free PHP script ... calendar via a web based ... display unlimited banner and ...
Read more