DateTime results from the CPAN

Album

view release on metacpan or search on metacpan

	    }
	}
	elsif ( $f =~ /^(.+)\.$movpat$/i ) {
	    $el->type(T_MPG);
	    my $assoc = $1."s.jpg";
	    $el->assoc_name($assoc);
	    if ( @files && $files[0] eq $assoc ) {
		shift(@files);
		warn(d_large($assoc).": Skipped still\n") if $verbose;
	    }
	}
	$gotlist->add($el, $f);
    }
}

sub load_import {
    my $dh = do { local *DH; *DH; };
    opendir($dh, $import_dir)
      or die("Cannot opendir $import_dir: $!\n");

    my @files = sort grep { !/^\./ && /$suffixpat$/ } readdir($dh);
    closedir($dh);

    while ( @files ) {
	my $f = shift(@files);
	next unless -f fjoin($import_dir, $f);

	my $el = new ImageInfo(fjoin($import_dir, $f));
	if ( $import_exif ) {
	    shift(@files) if handle_exif($f, $files[0], $el);
	}
	else {
	    $el->type(T_JPG);
	    if ( $f =~ /^(.+)\.$movpat$/i ) {
		$el->type(T_MPG);
		$el->assoc_name($1."s.jpg");
	    }
	    $implist->add($el, $f);
	}
    }
}

sub handle_exif {
    my ($file, $next, $el) = @_;

    # Sony DSC-V1 produces the following files:
    #   DSC0nnnn.JPG	still image
    #   DSC0nnnn.JPE	mail mode image*
    #   DSC0nnnn.MPG	voice mode image*
    #   DSC0nnnn.TIF	uncompressed image*
    #   CLP0nnnn.GIF	clip motion file
    #   CLP0nnnn.HTM	clip motion file index
    #   MBL0nnnn.GIF	clip motion file, mobile mode
    #   MBL0nnnn.HTM	clip motion file index, mobile mode
    #   MOV0nnnn.MPG	movie
    # Files marked with * have a normal still image associated.

    # Normal still image.
    if ( $file =~ /^(.{4})(\d{4})\.($picpat)$/i ) {
	my ($type, $seq, $ext) = ($1, $2, $3);
	my $fd = $el->DateTime || "";
	if ( $fd =~ /(\d\d\d\d):(\d\d):(\d\d) (\d\d):(\d\d):(\d\d)/ ) {
	    my $time = timelocal($6,$5,$4,$3,$2-1,$1);
	    my $new = "$1$2$3$4$5$6$seq";
	    my $ii = cache_entry("$new.$ext");
	    if ( $ii && !$ii->orig_name ) {
		$ii->orig_name(fjoin($import_dir, $file));
	    }

	    $el->type(T_JPG);
	    $el->dest_name("$new.$ext");
	    $el->timestamp($time);
	    $file = "$new.$ext";
	    cache_entry($file, $el) unless $ii;
	}
	else {
	    warn(fjoin($import_dir, $file).": Missing or unparsable file date [$fd]\n")
	      if $verbose;
	    $el->type(T_JPG);
	}
	if ( $next && $next eq "$type$seq.mpg" ) {
	    warn(fjoin($import_dir, $file).": Changed to VOICE\n") if $verbose;
	    $el->type(T_VOICE);
	    (my $t = $file) =~ s/\.jpg$/.mp3/i;
	    $el->assoc_name($t);
	    $implist->add($el);
	    return 1;
	}
	$implist->add($el);
    }

    # MPEG movie.
    elsif ( $file =~ /^(.{4})(\d{4})\.($movpat)$/i ) {
	my ($type, $seq, $ext) = ($1, $2, $3);
	# We have to trust the file date...
	my $time = $el->timestamp;
	my @tm = localtime($time);
	my $new = sprintf("%04d%02d%02d%02d%02d%02d$seq",
			  1900+$tm[5], 1+$tm[4], @tm[3,2,1,0]);
	my $ii = cache_entry("$new.$ext");
	if ( $ii && !$ii->orig_name ) {
	    $ii->orig_name(fjoin($import_dir, $file));
	}

	$el->type(T_MPG);
	$el->dest_name("$new.$ext");
	$el->assoc_name($new."s.jpg");
	$implist->add($el, "$new.$ext");
	$file = "$new.$ext";
	cache_entry($file, $el) unless $ii;
    }

    # Assume ordinary JPEG or some picture.
    elsif ( $file =~ /^.*$picpat$/) {
	$el->type(T_JPG);
	$el->orig_name(fjoin($import_dir, $file));
	$el->dest_name($file);
	$implist->add($el, $file);
    }

    # Assume ordinary MPEG or some movie.

script/album view on Meta::CPAN

    return '' unless $t;
    $t =~ s/\n+/$br/go;
    $t;
}

sub indent($$) {
    # Shift contents to the right so it fits pretty.
    my ($t, $n) = @_;
    $n = " " x $n;
    return $n unless $t;
    $t = detab($t);
    $t =~ s/\n+$//;
    $t =~ s/\n/\n$n/g;
    $t;
}

sub img($%) {
    my ($file, %atts) = @_;
    my $ret = "<img src='" . $file . "'";
    foreach ( sort(keys(%atts)) ) {
	$ret .= " $_='" . $atts{$_} . "'";
    }
    $ret . ">";
}

#### Size helpers.

sub bytes($) {
    my $t = shift;
    return $t . "b" if $t < 10*1024;
    return ($t >> 10) . "kb" if $t < 10*1024*1024;
    ($t >> 20) . "Mb";
}

sub size_info($;$) {
    my ($el, $med) = @_;
    return unless $el->width;

    my $ret = "";
    $ret .= $el->width . "x" . $el->height if $el->width;
    for ( $med ? $el->medium_size : $el->file_size ) {
	next unless $_;
	$ret .= "," if $ret;
	$ret .= bytes($_);
    }
    $ret;
}

#### EXIF helpers.

sub restyle_exif($) {
    my ($el) = @_;
    my $ret = "";
    my $v;

    my $app = sub {
	$ret .= "<tr><td>".htmln($_[0])."</td>".
	            "<td>".htmln($_[1])."</td></tr>\n";
    };

    $app->("Date", $v) if $v = $el->DateTime;
    my $t = $el->ExposureTime || 0;
    if ( $t && $t <= 0.5 ) {
	$t = "1/".int(0.5 + 1/$t)."s";
    }
    $app->("Exposure",
	   join(" ", $el->ExposureMode || "",
		$el->ExposureProgram || "", $t));
    $app->("Aperture", sprintf("%.1f", $v))
      if $v = $el->FNumber;
    if ( $v = $el->FocalLength ) {
	if ( $el->Model eq "DSC-V1" ) {
	    $v .= sprintf("mm  (%.1fmm equiv.)", $v*4.857);
	}
	else {
	    $v .= "mm";
	}
	$app->("Focal length", $v);
    }
    $app->("ISO", $v) if $v = $el->ISOSpeedRatings;
    $app->("Flash", $v)
      if ($v = $el->Flash) && $v ne "Flash did not fire";
    $app->("Metering", $v) if $v = $el->MeteringMode;
    $app->("Scene", $v) if $v = $el->SceneCaptureType;
    $app->("Camera",
	   join(" ", $v, $el->Model))
      if $v = $el->Make;
}

#### Caption helpers.

sub f_caption($) {
    my ($el) = @_;
    my $s = htmln($el->dest_name);
    if ( $el->Make ) {
	$s = "&nbsp;$s<a href='#' class='info'>&nbsp;<span>".
	  "<table border='1' width='100%'>\n".
	    restyle_exif($el) . "</table>\n".
	      "</span></a>";
    }
    $s;
}

sub s_caption($) {
    my ($el) = @_;
    size_info($el, $medium);
}

sub t_caption($) {
    my ($el) = @_;
    $el->tag  ? htmln($el->tag) : "";
}

sub c_caption($) {
    my ($el) = @_;
    my $t = $el->description || "";
    $t =~ s/\n.*//;
    htmln($t);
}

#### Misc.

script/album view on Meta::CPAN

    if ( $import_dir ) {
	die("$import_dir: Not a directory\n")
	  unless -d $import_dir;
	$import_dir =~ s;^\./;;;
    }
}

sub app_ident {
    print STDERR ("This is $my_package [$my_name $my_version]\n");
}

sub app_usage {
    my ($exit) = @_;
    app_ident();
    print STDERR heredoc(<<"    EndOfUsage", 4);
    Usage: $0 [options] [ directory ]
      Album:
	--info XXX          description file, default "@{[DEFAULTS->{info}]}" (if it exists)
	--title XXX         album title, default "@{[DEFAULTS->{title}]}"
	--[no]icon          [do not] produce an album icon
      Index:
	--cols NN           number of columns per page, default @{[DEFAULTS->{indexcols}]}
	--rows NN           number of rows per page, default @{[DEFAULTS->{indexrows}]}
	--thumbsize NNN     the max size of thumbnail images, default @{[DEFAULTS->{thumbsize}]}
	--captions XXX      f: filename s: size c: description t: tag
      Medium:
	--medium            produce medium sized images of size @{[DEFAULTS->{mediumsize}]}
	--mediumsize NNN    the max size of medium sized images, default @{[DEFAULTS->{mediumsize}]}
	--mediumonly        ignore large images and links (for web export)
      Importing:
	--import XXX        original images
	--exif              use w/ EXIF info, if possible
	--dcim XXX          as --import with --exif
	--update            add new entries from import, if needed
	--[no]link          [do not] link to original, instead of copying. Default is link.
      Miscellaneous:
	--clobber           recreate everything (except large)
	--test              verify only
	--help              this message
	--ident             show identification
	--verbose           verbose information
    EndOfUsage
    exit $exit if defined $exit && $exit != 0;
}

################ Modules ################

package ImageInfo;

my @std_fields;
my @exif_fields;
my $exif_rot;

INIT {
    @std_fields  = qw(type seq next prev
		      dest_name orig_name assoc_name
		      timestamp file_size medium_size
		      tag description annotation
		      rotation mirror);

    @exif_fields = qw(DateTime ExifImageLength ExifImageWidth
		      ExposureMode ExposureProgram ExposureTime
		      FNumber Flash FocalLength ISOSpeedRatings
		      ImageDescription Make Model
		      MeteringMode SceneCaptureType Orientation
		      height width file_ext);

    $exif_rot = { top_left   => [   0, ''  ],    # 1: no corr. needed
		  top_right  => [   0, 'v' ],    # 2: flop (V)
		  bot_right  => [ 180, ''  ],    # 3: 180
		  bot_left   => [   0, 'h' ],    # 4: flip (H)
		  left_top   => [  90, 'h' ],    # 5: flip 90
		  right_top  => [  90, ''  ],    # 6: 90
		  right_bot  => [  90, 'v' ],    # 7: flop 90
		  left_bot   => [ 270, ''  ],    # 8: 270
		};
}

my $largepat;
sub basename_nolarge {
    my ($f) = @_;
    unless ( $largepat ) {
	$largepat = quotemeta(::d_large());
	$largepat = qr;^$largepat[/\\];;
    }
    $f =~ s;$largepat;;;
    $f;
}

sub new {
    my ($pkg, $file) = @_;
    $pkg = ref($pkg) if ref($pkg);

    my $self = { $file ?
		 (orig_name    => $file,
		  dest_name    => basename_nolarge($file)) : (),
		 description  => "",
		 annotation   => [],
		 tag	      => "",
	       };

    if ( $file && -f $file ) {
	my @st = stat(_);
	my $ii = ::cache_entry($file);
	if ( $ii  ){
	    $self = $ii;
	    delete($self->{$_}) foreach grep { /^_/ } keys(%$self);
	}

	# Else, get image info.
	else {
	    my $ii = Image::Info::image_info($file);
	    $self->{file_size} = $st[7];
	    $self->{timestamp} = $st[9];
	    unless ( exists($ii->{error}) ) {
		for my $key ( @exif_fields ) {
		    my $val = $ii->{$key};
		    next unless defined $val;
		    if ( $key eq "Orientation" ) {
			($self->{rotation}, $self->{mirror}) =
			  @{$exif_rot->{$val}}

( run in 1.628 second using v1.01-cache-2.11-cpan-140bd7fdf52 )