Scratching my head over why I get "No such file or directory" errors from "warn" on each of the system() calls in the program below...this even though the program still works.
Also I'd very like to know how to perform the first two via Image::ExifTool rather than a system() call.
#!/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 bo
+rder 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 M
+PO 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 f
+or 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}); # Gen
+erate 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 Per
+lish 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;
-
Are you posting in the right place? Check out Where do I post X? to know for sure.
-
Posts may use any of the Perl Monks Approved HTML tags. Currently these include the following:
<code> <a> <b> <big>
<blockquote> <br /> <dd>
<dl> <dt> <em> <font>
<h1> <h2> <h3> <h4>
<h5> <h6> <hr /> <i>
<li> <nbsp> <ol> <p>
<small> <strike> <strong>
<sub> <sup> <table>
<td> <th> <tr> <tt>
<u> <ul>
-
Snippets of code should be wrapped in
<code> tags not
<pre> tags. In fact, <pre>
tags should generally be avoided. If they must
be used, extreme care should be
taken to ensure that their contents do not
have long lines (<70 chars), in order to prevent
horizontal scrolling (and possible janitor
intervention).
-
Want more info? How to link
or How to display code and escape characters
are good places to start.