File Coverage

lib/Panotools/Photos.pm

Criterion	Covered	Total	%
statement	119	145	82.0
branch	35	62	56.4
condition	12	36	33.3
subroutine	15	18	83.3
pod	12	13	92.3
total	193	274	70.4

package Panotools::Photos;

=head1 NAME

Panotools::Photos - Photo sets

=head1 SYNOPSIS

Query sets of photos

=head1 DESCRIPTION

A collection of photos has possibilities, it could be one or more panoramas or a
bracketed set.  This module provides some methods for describing groups of
photos based on available metadata

=cut

use strict;
use warnings;

use File::Spec;
use Image::ExifTool;

=head1 USAGE

Create a new object like so:

  my $photos = new Panotools::Photos;

Alternatively supply some filenames:

  my $photos = new Panotools::Photos ('DSC_0001.JPG', 'DSC_0002.JPG');

=over

=cut

sub new
{
    my $class = shift;
    $class = ref $class || $class;
    my $self = bless [], $class;
    $self->Paths (@_);
    return $self;
}

=item Paths

Add to or get the list of image filenames:

  $photos->Paths ('DSC_0003.JPG', 'DSC_0004.JPG');
  my @paths = $photos->Paths;

=cut

sub Paths
{
    my $self = shift;
    for my $path (@_)
    {
        push @{$self}, {path => $path, exif => Image::ExifTool::ImageInfo ($path)};
    }
    return map ($_->{path}, @{$self});
}

=item Stub

Construct a stub filename from the names of the first and last images in the
list.

  my $stub = $photos->Stub;

e.g. DSC_0001.JPG DSC_0002.JPG DSC_0003.JPG -> DSC_0001-DSC_0003

=cut

sub Stub
{
    my $self = shift;
    my $path_a = $self->[0]->{path};
    my $path_b = $self->[-1]->{path};
    # strip any suffixes
    $path_a =~ s/\.[[:alnum:]]+$//;
    $path_b =~ s/\.[[:alnum:]]+$//;
    # strip all but filename
    $path_b =~ s/.*[\/\\]//;
    return $path_a .'-'. $path_b;
}

=item Bracketed

Query to discover if this is a likely bracketed set.  i.e. is the total number
of photos divisible by the number of different exposures:

  &do_stuff if ($photos->Bracketed);

=cut

sub Bracketed
{
    my $self = shift;
    # bracketed photos are not shot on 'Auto Exposure'
    for my $index (0 .. scalar @{$self} -1)
    {
        next unless defined $self->[$index]->{exif}->{ExposureMode};
        return 0 if $self->[$index]->{exif}->{ExposureMode} eq 'Auto';
    }
    my $brackets = scalar (@{$self->Speeds});
    # require equal numbers of each exposure level
    return 0 if (scalar (@{$self}) % $brackets);
    # require more than one exposure level
    return 0 if ($brackets < 2);
    # require bracketing order repeats: 1/50 1/100 1/200 1/50 1/100 1/200 etc...
    for my $index ($brackets .. scalar @{$self} -1)
    {
        return 0 unless $self->[$index]->{exif}->{ExposureTime} eq $self->[$index - $brackets]->{exif}->{ExposureTime};
    }

    return 1;
}

=item Layered

Query to discover if this is a layered set, i.e. there is a large exposure
difference in the set, but it isn't bracketed.

  &do_stuff if ($photos->Layered);

By default the threshold is 4, e.g. exposures varying between 2 and 1/2
seconds indicate layers.  Vary this threshold like so:

  &do_stuff if ($photos->Layered (2));

=cut

sub Layered
{
    my $self = shift;
    my $factor = shift || 4;
    return 0 if $self->Bracketed;
    my $longest = $self->Speeds->[0];
    my $shortest = $self->Speeds->[-1];
    if ($longest =~ /^1\/([0-9]+)$/) {$longest = 1 / $1};
    if ($shortest =~ /^1\/([0-9]+)$/) {$shortest = 1 / $1};
    return 0 unless $longest or $shortest;
    return 0 if $shortest == 0;
    return 0 if $longest / $shortest < $factor;
    return 1;
}

=item Speeds

Get a list of exposure times sorted with longest exposure first

  @speeds = @{$photos->Speeds};

=cut

sub Speeds
{
    my $self = shift;
    my $speeds = {};
    for my $image (@{$self})
    {
        my $et = $image->{exif}->{ShutterSpeedValue} || $image->{exif}->{ExposureTime} || $image->{exif}->{ShutterSpeed} || 0;
        $speeds->{$et} = 'TRUE';
    }
    return [sort {_normalise ($b) <=> _normalise ($a)} keys %{$speeds}];
}

sub _normalise
{
    my $number = shift;
    if ($number =~ /^1\/([0-9]+)$/) {$number = 1 / $1};
    return $number;
}

=item SplitInterval

Given a set of photos, split it into a one or more sets by looking at the
variation of time interval between shots.  e.g. typically the interval between
shots in a panorama varies by less than 15 seconds.  A variation greater than
that indicates the start of the next panorama:

  my @sets = $photos->SplitInterval (15);

Sets with an average interval greater than 4x this variation are not considered
panoramas at all and discarded.

=cut

sub SplitInterval
{
    my $self = shift;
    my $d_inc = shift || 15;
    my $max_inc = $d_inc * 4;
    my @groups;

    my $group_tmp = new Panotools::Photos;
    my $previous_time;
    my $previous_inc = 0;
    for my $image (@{$self})
    {
        my $datetime = $image->{exif}->{'DateTimeOriginal'} || $image->{exif}->{'FileModifyDate'};
        my $time_unix = Image::ExifTool::GetUnixTime ($datetime);
        $previous_time = $time_unix unless (defined $previous_time);
        my $inc = $time_unix - $previous_time;

        if (($inc - $previous_inc) > $d_inc)
        {
            push @groups, $group_tmp if ($group_tmp->AverageInterval < $max_inc);
            $group_tmp = new Panotools::Photos;
        }
        push @{$group_tmp}, $image;

        $previous_time = $time_unix;
        $previous_inc = $inc;
    }
    push @groups, $group_tmp if ($group_tmp->AverageInterval < $max_inc);
    return @groups;
}

=item AverageInterval

Get the average time between shots:

  $average = $photos->AverageInterval;

=cut

sub AverageInterval
{
    my $self = shift;
    return 0 unless (scalar @{$self} > 1);

    my $start = $self->[0]->{exif}->{'DateTimeOriginal'} || $self->[0]->{exif}->{'FileModifyDate'};
    my $end = $self->[-1]->{exif}->{'DateTimeOriginal'} || $self->[-1]->{exif}->{'FileModifyDate'};

    my $totaltime = Image::ExifTool::GetUnixTime ($end) - Image::ExifTool::GetUnixTime ($start);
    return $totaltime / (scalar @{$self} -1);
}

=item FOV FocalLength Rotation

Get the Angle of View in degrees of the first photo:

  $photos->FOV;

..or any other photo (-1 is last):

  $photos->FOV (123);

Returns undef if the FOV can't be calculated.

=cut

sub FOV
{
    my $self = shift;
    my $index = 0;
    $index = shift if @_;
    my $fov = $self->[$index]->{exif}->{'FOV'};
    $fov =~ s/ .*$// if defined $fov;
    return $fov;
}

sub FocalLength
{
    my $self = shift;
    my $index = 0;
    $index = shift if @_;
    my $fl = $self->[$index]->{exif}->{'FocalLengthIn35mmFormat'};
    $fl =~ s/ .*$// if defined $fl;
    return $fl;
}

sub Rotation
{
    my $self = shift;
    my $index = shift || 0;
    my $rotation = $self->[$index]->{exif}->{'Rotation'} || undef;
    return 0 unless $rotation;
    return 0 if $rotation =~ /Mirror/;
    return 0 if ($self->[$index]->{exif}->{'ImageWidth'}
                     < $self->[$index]->{exif}->{'ImageHeight'});
    return 90 if $rotation =~ /Rotate 90 CW/;
    return 180 if $rotation =~ /Rotate 180/;
    return -90 if $rotation =~ /Rotate 270 CW/;
    return 0;

#    1 => 'Horizontal (normal)',
#    3 => 'Rotate 180',
#    6 => 'Rotate 90 CW',
#    8 => 'Rotate 270 CW',

#    2 => 'Mirror horizontal',
#    4 => 'Mirror vertical',
#    5 => 'Mirror horizontal and rotate 270 CW',
#    7 => 'Mirror horizontal and rotate 90 CW',

}

=item Eev

Get an EV value for a photo, this will be guessed from partial EXIF data:

  $photos->Eev ($index);

=cut

sub Eev
{
    my $self = shift;
    my $index = shift || 0;
    my $exif = $self->[$index]->{exif};
    my $aperture = $exif->{Aperture} || 1.0;
    my $et = $exif->{ExposureTime} || $exif->{ShutterSpeed} || 1.0;
    if ($et =~ /^1\/([0-9]+)$/) {$et = 1 / $1};
    my $iso = $exif->{ISO} || 100;
    # (A light value of 0 is defined as f/1.0 at 1 second with ISO 100)
    return sprintf ('%.3f', (2*log ($aperture) - log($et) - log($iso/100)) / log(2));
}

=item AverageRGB

Find the mean average colour balance for all photos:

  ($red, $green, $blue) = $photos->AverageRGB;

=back

=cut

sub AverageRGB
{
    my $self = shift;
    my $RedBalance = 0;
    my $GreenBalance = 0;
    my $BlueBalance = 0;
    my $count = 0;
    for my $image (@{$self})
    {
        next unless ($image->{exif}->{'RedBalance'} and $image->{exif}->{'BlueBalance'});
        $RedBalance   += $image->{exif}->{'RedBalance'};
        $GreenBalance += $image->{exif}->{'GreenBalance'} if defined $image->{exif}->{'GreenBalance'};
        $BlueBalance  += $image->{exif}->{'BlueBalance'};
        $count++;
    }
    return (1,1,1) unless $count;
    return ($RedBalance / $count, $GreenBalance / $count, $BlueBalance / $count);
}

1;