#!/usr/bin/perl -w
# Split_MPO.pl, Version 2013-10-11 by Gan Uesli Starling
# A program to separate MPO files into a conjoined stereo pair with border around each frame.
# Requires both ExifTool and ImageMagick to be installed in system.

use Image::ExifTool qw(:Public);

# Below are user options;
my $directory = './';
my $border = 2; # Number of pixels to add as border around each frame.
my $border_color = 'DarkRed'; # Color of border to add.
my $view_style = 'crosseye'; # Options are 'crosseye' and 'straight';

$exif_tool = new Image::ExifTool;

# Below are internal variables;
my $re_filetype = '^.*.(mpo|MPO)$'; # RegEx for how to recognized an MPO file.
my %placement = ( crosseye => 'R.jpg L.jpg', straight => 'L.jpg R.jpg'); # Order of placement for left & right frames;
my %prefix_id = ( crosseye => 'X', straight => 'S'); # Naming prefix for output files acccording to placement of left & right frames;

# Get a list of all *.mpo files, then split & rejoin each one.
sub split_mpo_files {
    my ($dir, $re_hunt, $border, $view_style) = @_;
    my @file_list = hunt_files($dir, $re_hunt);
    for my $mpo (@file_list) { 
        $exif_tool->ExtractInfo($mpo, []);
        my $geometry = add_border(
            $exif_tool->GetValue('ImageWidth', 'PrintConv'),            
            $exif_tool->GetValue('ImageHeight', 'PrintConv'),
            $border
        );
        my $stereo = output_name($mpo, $prefix_id{$view_style}); # Generate output filename.
        for ( "L.jpg", "R.jpg") {unlink $_}; # Delete temporaary files.
        print "Splitting $mpo into $stereo\n";
        # Extract main (left) image.
        # Issued via CLI because I've not yet puzzled this out the Perlish way.
        system("exiftool -trailer:all= $mpo -o L.jpg") 
            or warn("ExifTool error on image 1: $!")
        ; 
        # Extract second (right) image.
        system("exiftool $mpo -mpimage2 -b > R.jpg") 
            or warn("ExifTool error on image 2: $!")
        ;  
        # Generate the stereo image via ImageMagick
        # Issued via CLI because Image::Magick would not install into 64-bit Strawberry Perl on Win7.
        system("montage -tile 2x0 -border $border -bordercolor $border_color -background $border_color -geometry $geometry $placement{$view_style} $stereo")
            or warn ("ImageMagick error on montage: $!")
        ;
        last;
    }
}

# Return a lists of files from path that match a RegEx.
sub hunt_files {
    my ($path, $re) = @_;
    my @list;
    opendir ( my $dh, $path ) || die "Error in opening dir $path\n";
    while( (my $file = readdir( $dh ))){
         push @list, $file if $file =~ m/$re/;
    }
    closedir($dh);
    return @list;
}

# Increase geometry of single frame by the border to be added.
sub add_border {
    my ($x, $y, $border) = @_;
    my @new;
    for ($x, $y) {push @new, $_ + $border * 2}
    return join('x', @new);
}

# Create a name for the stereo output file;
sub output_name {
    my ($name, $prefix_id) = @_;
    $name =~ s{\.(mpo|MPO)$}{.jpg};
    return $prefix_id . '_' . $name;
}

# Perform the split on all matching files in given directory.
split_mpo_files(
    $directory,
    $re_filetype, 
    $border,
    $view_style
);

print "All done!\n";
sleep 5;