From: <bru...@us...> - 2009-05-24 15:25:36
|
Revision: 979 http://panotools.svn.sourceforge.net/panotools/?rev=979&view=rev Author: brunopostle Date: 2009-05-24 15:25:26 +0000 (Sun, 24 May 2009) Log Message: ----------- Remove pto2fulla and pto2tiff as they are superceded by tca_correct and pto2mk Modified Paths: -------------- trunk/Panotools-Script/Changes trunk/Panotools-Script/MANIFEST trunk/Panotools-Script/META.yml trunk/Panotools-Script/Makefile.PL trunk/Panotools-Script/dos/make_exe.pl Removed Paths: ------------- trunk/Panotools-Script/bin/pto2fulla trunk/Panotools-Script/bin/pto2tiff Modified: trunk/Panotools-Script/Changes =================================================================== --- trunk/Panotools-Script/Changes 2009-05-24 12:53:35 UTC (rev 978) +++ trunk/Panotools-Script/Changes 2009-05-24 15:25:26 UTC (rev 979) @@ -7,6 +7,8 @@ - unfinished tool ptovariable for setting optimisation parameters - match-n-shift does photometric optimisation unless --stacks specified - erect2qtvr uses sips instead of ImageMagick on OS X + - remove pto2fulla as superceded by tca_correct + - remove pto2tiff as superceded by pto2mk 0.21 - ptoclean, don't give autooptimiser projects with invalid lenses Modified: trunk/Panotools-Script/MANIFEST =================================================================== --- trunk/Panotools-Script/MANIFEST 2009-05-24 12:53:35 UTC (rev 978) +++ trunk/Panotools-Script/MANIFEST 2009-05-24 15:25:26 UTC (rev 979) @@ -14,8 +14,6 @@ bin/panostart bin/process-masks bin/process-masks-gui -bin/pto2fulla -bin/pto2tiff bin/ptocentre bin/ptoclean bin/ptograph Modified: trunk/Panotools-Script/META.yml =================================================================== --- trunk/Panotools-Script/META.yml 2009-05-24 12:53:35 UTC (rev 978) +++ trunk/Panotools-Script/META.yml 2009-05-24 15:25:26 UTC (rev 979) @@ -1,7 +1,7 @@ # http://module-build.sourceforge.net/META-spec.html #XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# name: Panotools-Script -version: 0.21 +version: 0.22 version_from: lib/Panotools/Script.pm installdirs: site requires: Modified: trunk/Panotools-Script/Makefile.PL =================================================================== --- trunk/Panotools-Script/Makefile.PL 2009-05-24 12:53:35 UTC (rev 978) +++ trunk/Panotools-Script/Makefile.PL 2009-05-24 15:25:26 UTC (rev 979) @@ -5,8 +5,8 @@ 'NAME' => 'Panotools::Script', 'EXE_FILES' => [ 'bin/cubic2erect', 'bin/erect2cubic', 'bin/pafextract', 'bin/jpeg2qtvr', 'bin/erect2qtvr', 'bin/enblend-mask', 'bin/match-n-shift', 'bin/ptoset', - 'bin/process-masks', 'bin/erect2planet', 'bin/pto2tiff', 'bin/ptograph', 'bin/ptoget', - 'bin/tif2svg', 'bin/enblend-svg', 'bin/pto2fulla', 'bin/ptoinfo', 'bin/ptopath', + 'bin/process-masks', 'bin/erect2planet', 'bin/ptograph', 'bin/ptoget', + 'bin/tif2svg', 'bin/enblend-svg', 'bin/ptoinfo', 'bin/ptopath', 'bin/qtvr2erect-gui', 'bin/tif2svg-gui', 'bin/ptoinfo-gui', 'bin/ptosort', 'bin/ptovariable', 'bin/process-masks-gui', 'bin/enblend-svg-gui', 'bin/erect2qtvr-gui', 'bin/ptoclean', 'bin/erect2mercator', 'bin/ptosplit', 'bin/ptomerge', 'bin/panostart', 'bin/ptsed', 'bin/ptscluster', Deleted: trunk/Panotools-Script/bin/pto2fulla =================================================================== --- trunk/Panotools-Script/bin/pto2fulla 2009-05-24 12:53:35 UTC (rev 978) +++ trunk/Panotools-Script/bin/pto2fulla 2009-05-24 15:25:26 UTC (rev 979) @@ -1,76 +0,0 @@ -#!/usr/bin/perl -use strict; -use warnings; - -use Panotools::Script; - -my $results; -my $pi = 3.14159; - -for my $file (@ARGV) -{ - my $pto = new Panotools::Script; - $pto->Read ($file); - my $green = $pto->Image->[0]; - my $red = $pto->Image->[1]; - my $blue = $pto->Image->[2]; - - my $red_scale = sin ($green->{v} * $pi / 360) / sin ($red->{v} * $pi / 360); - my $blue_scale = sin ($green->{v} * $pi / 360) / sin ($blue->{v} * $pi / 360); - - my $red_d = 1 - $red->{a} - $red->{b} - $red->{c}; - my $blue_d = 1 - $blue->{a} - $blue->{b} - $blue->{c}; - - my $red_a = sprintf "%f", $red->{a} * $red_scale * $red_scale * $red_scale * $red_scale; - my $red_b = sprintf "%f", $red->{b} * $red_scale * $red_scale * $red_scale; - my $red_c = sprintf "%f", $red->{c} * $red_scale * $red_scale; - $red_d = sprintf "%f", $red_d * $red_scale; - - my $blue_a = sprintf "%f", $blue->{a} * $blue_scale * $blue_scale * $blue_scale * $blue_scale; - my $blue_b = sprintf "%f", $blue->{b} * $blue_scale * $blue_scale * $blue_scale; - my $blue_c = sprintf "%f", $blue->{c} * $blue_scale * $blue_scale; - $blue_d = sprintf "%f", $blue_d * $blue_scale; - - $results .= "-r $red_a:$red_b:$red_c:$red_d -b $blue_a:$blue_b:$blue_c:$blue_d\n"; -} - -print $results; - -__END__ - -=head1 NAME - -pto2fulla - extract fulla TCA parameters from a prepared .pto project - -=head1 Synopsis - - pto2fulla tca.pto - -=head1 DESCRIPTION - -Takes hugin .pto projects created according to this tutorial: -L<http://hugin.sourceforge.net/tutorials/tca/> -outputs 'fulla' command-line parameters suitable for correcting -transverse chromatic aberration. - -=head1 Calling syntax - - pto2fulla <pto-file> - -=head1 License - -This program is free software; you can redistribute it and/or -modify it under the terms of the GNU General Public License -as published by the Free Software Foundation; either version 2 -of the License, or (at your option) any later version. - -=head1 See Also - -L<http://panotools.sourceforge.net/> - -=head1 Author - -Bruno Postle, E<lt>bruno (at) postle.netE<gt> - -=cut - Deleted: trunk/Panotools-Script/bin/pto2tiff =================================================================== --- trunk/Panotools-Script/bin/pto2tiff 2009-05-24 12:53:35 UTC (rev 978) +++ trunk/Panotools-Script/bin/pto2tiff 2009-05-24 15:25:26 UTC (rev 979) @@ -1,84 +0,0 @@ -#!/usr/bin/perl - -use strict; -use warnings; -use File::Spec; - -my @files = @ARGV; -@files = map File::Spec->rel2abs ($_), @files; - -for my $pto (@files) -{ - my $stub = $pto; - $stub =~ s/\.pto$//i; - - use Panotools::Script; - - my $p = new Panotools::Script; - $p->Read ($pto); - if (scalar @{$p->{image}} == 1) - { - $p->Panorama->Set (n => '"TIFF c:DEFLATE"'); - } - else - { - $p->Panorama->Set (n => '"TIFF_m c:DEFLATE"'); - } - my $pto_temp = "$stub.pto2tiff.$$.pto"; - $p->Write ($pto_temp); - system ('nona-mask', '-o', $stub, $pto_temp); - unlink $pto_temp; - - if (scalar @{$p->{image}} > 1) - { - my @temp_files; - for my $index (0 .. scalar @{$p->{image}} - 1) - { - push @temp_files, ($stub . sprintf ('%.4d', $index) .'.tif'); - } - - my @args; - push @args ,'-w' if $p->Panorama->{v} == 360; - - system ('enblend-mask', @args, '-o', "$stub.tif", @temp_files); - } - system ('convert', "$stub.tif", "$stub.jpg"); - - print STDERR "Done: $stub.tif\n"; -} - -__END__ - -=head1 NAME - -pto2tiff - Batch process hugin project files - -=head1 Synopsis - - pto2tiff project1.pto [project2.pto ...] - -=head1 DESCRIPTION - -The nona stitcher can be used for batch stitching hugin pto projects. This -tool is a simple wrapper that forces the output format into a suitable input -format for enblend, it then runs enblend (actually enblend-mask) with -appropriate arguments to generate a single blended output. - -L<http://hugin.sourceforge.net/> -L<http://enblend.sourceforge.net/> - -=head1 License - -This program is free software; you can redistribute it and/or -modify it under the terms of the GNU General Public License -as published by the Free Software Foundation; either version 2 -of the License, or (at your option) any later version. - -=head1 See Also - -L<perl>, L<Panotools::Script> - -=head1 Author - -Bruno Postle <bruno AT postle.net> - Modified: trunk/Panotools-Script/dos/make_exe.pl =================================================================== --- trunk/Panotools-Script/dos/make_exe.pl 2009-05-24 12:53:35 UTC (rev 978) +++ trunk/Panotools-Script/dos/make_exe.pl 2009-05-24 15:25:26 UTC (rev 979) @@ -19,8 +19,6 @@ pafextract panostart process-masks -pto2fulla -pto2tiff ptocentre ptoclean ptoget This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bru...@us...> - 2009-06-01 20:25:33
|
Revision: 981 http://panotools.svn.sourceforge.net/panotools/?rev=981&view=rev Author: brunopostle Date: 2009-06-01 20:25:23 +0000 (Mon, 01 Jun 2009) Log Message: ----------- Add new libpano projections to pod documentation Modified Paths: -------------- trunk/Panotools-Script/Changes trunk/Panotools-Script/lib/Panotools/Script/Line/Image.pm trunk/Panotools-Script/lib/Panotools/Script/Line/Panorama.pm Modified: trunk/Panotools-Script/Changes =================================================================== --- trunk/Panotools-Script/Changes 2009-05-24 21:14:03 UTC (rev 980) +++ trunk/Panotools-Script/Changes 2009-06-01 20:25:23 UTC (rev 981) @@ -1,5 +1,8 @@ Revision history for Panotools::Script. +0.23 + - Add new projections to pod documentation + 0.22 - Use ImageMagick to workaround matchpoint alpha channel bug - panostart --nostacks option for point-and-shoot sequences with random exposure Modified: trunk/Panotools-Script/lib/Panotools/Script/Line/Image.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Script/Line/Image.pm 2009-05-24 21:14:03 UTC (rev 980) +++ trunk/Panotools-Script/lib/Panotools/Script/Line/Image.pm 2009-06-01 20:25:23 UTC (rev 981) @@ -31,6 +31,11 @@ 2 - Circular fisheye 3 - full-frame fisheye 4 - PSphere, equirectangular + 7 - Mirror (a spherical mirror) + 8 - Orthographic fisheye + 10 - Stereographic fisheye + 21 - Equisolid fisheye + v82 horizontal field of view of image (required) y0 yaw angle (required) p43 pitch angle (required) Modified: trunk/Panotools-Script/lib/Panotools/Script/Line/Panorama.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Script/Line/Panorama.pm 2009-05-24 21:14:03 UTC (rev 980) +++ trunk/Panotools-Script/lib/Panotools/Script/Line/Panorama.pm 2009-06-01 20:25:23 UTC (rev 981) @@ -28,6 +28,14 @@ 8 - Lambert Equal Area Cylindrical 9 - Lambert Azimuthal 10 - Albers Equal Area Conical + 11 - Miller Cylindrical + 12 - Panini + 13 - Architectural + 14 - Orthographic + 15 - Equisolid + 16 - Equirectangular Panini + 17 - Biplane + 18 - Triplane v360 horizontal field of view of panorama (default 360) nPICT Panorama file format, one of: This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bru...@us...> - 2009-06-01 20:28:21
|
Revision: 982 http://panotools.svn.sourceforge.net/panotools/?rev=982&view=rev Author: brunopostle Date: 2009-06-01 20:28:20 +0000 (Mon, 01 Jun 2009) Log Message: ----------- Add empty 'v' line to all output as panotools chokes without 'v' lines Modified Paths: -------------- trunk/Panotools-Script/Changes trunk/Panotools-Script/lib/Panotools/Script/Line/Variable.pm Modified: trunk/Panotools-Script/Changes =================================================================== --- trunk/Panotools-Script/Changes 2009-06-01 20:25:23 UTC (rev 981) +++ trunk/Panotools-Script/Changes 2009-06-01 20:28:20 UTC (rev 982) @@ -2,6 +2,7 @@ 0.23 - Add new projections to pod documentation + - Add empty 'v' line to all output as panotools chokes without 'v' lines 0.22 - Use ImageMagick to workaround matchpoint alpha channel bug Modified: trunk/Panotools-Script/lib/Panotools/Script/Line/Variable.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Script/Line/Variable.pm 2009-06-01 20:25:23 UTC (rev 981) +++ trunk/Panotools-Script/lib/Panotools/Script/Line/Variable.pm 2009-06-01 20:28:20 UTC (rev 982) @@ -82,6 +82,7 @@ } $string .= (join ' ', ($self->Identifier, @tokens)) ."\n"; } + $string .= $self->Identifier ."\n"; return $string; } This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bru...@us...> - 2009-06-18 20:43:59
|
Revision: 997 http://panotools.svn.sourceforge.net/panotools/?rev=997&view=rev Author: brunopostle Date: 2009-06-18 20:43:58 +0000 (Thu, 18 Jun 2009) Log Message: ----------- Add enfuse-mask tool based on enblend-mask Modified Paths: -------------- trunk/Panotools-Script/Changes trunk/Panotools-Script/MANIFEST trunk/Panotools-Script/Makefile.PL Added Paths: ----------- trunk/Panotools-Script/bin/enfuse-mask Modified: trunk/Panotools-Script/Changes =================================================================== --- trunk/Panotools-Script/Changes 2009-06-18 20:42:48 UTC (rev 996) +++ trunk/Panotools-Script/Changes 2009-06-18 20:43:58 UTC (rev 997) @@ -1,8 +1,9 @@ Revision history for Panotools::Script. 0.23 - - Add new projections to pod documentation + - Add new projections to pod documentation and ptoinfo output - Add empty 'v' line to all output as panotools chokes without 'v' lines + - New enfuse-mask tool based on enblend-mask 0.22 - Use ImageMagick to workaround matchpoint alpha channel bug Modified: trunk/Panotools-Script/MANIFEST =================================================================== --- trunk/Panotools-Script/MANIFEST 2009-06-18 20:42:48 UTC (rev 996) +++ trunk/Panotools-Script/MANIFEST 2009-06-18 20:43:58 UTC (rev 997) @@ -2,6 +2,7 @@ bin/enblend-mask bin/enblend-svg bin/enblend-svg-gui +bin/enfuse-mask bin/erect2cubic bin/erect2mercator bin/erect2planet Modified: trunk/Panotools-Script/Makefile.PL =================================================================== --- trunk/Panotools-Script/Makefile.PL 2009-06-18 20:42:48 UTC (rev 996) +++ trunk/Panotools-Script/Makefile.PL 2009-06-18 20:43:58 UTC (rev 997) @@ -5,7 +5,7 @@ 'NAME' => 'Panotools::Script', 'EXE_FILES' => [ 'bin/cubic2erect', 'bin/erect2cubic', 'bin/pafextract', 'bin/jpeg2qtvr', 'bin/erect2qtvr', 'bin/enblend-mask', 'bin/match-n-shift', 'bin/ptoset', - 'bin/process-masks', 'bin/erect2planet', 'bin/ptograph', 'bin/ptoget', + 'bin/process-masks', 'bin/erect2planet', 'bin/ptograph', 'bin/ptoget', 'bin/enfuse-mask', 'bin/tif2svg', 'bin/enblend-svg', 'bin/ptoinfo', 'bin/ptopath', 'bin/qtvr2erect-gui', 'bin/tif2svg-gui', 'bin/ptoinfo-gui', 'bin/ptosort', 'bin/ptovariable', 'bin/process-masks-gui', 'bin/enblend-svg-gui', 'bin/erect2qtvr-gui', 'bin/ptoclean', Added: trunk/Panotools-Script/bin/enfuse-mask =================================================================== --- trunk/Panotools-Script/bin/enfuse-mask (rev 0) +++ trunk/Panotools-Script/bin/enfuse-mask 2009-06-18 20:43:58 UTC (rev 997) @@ -0,0 +1,119 @@ +#!/usr/bin/perl + +use strict; +use warnings; +use File::Temp qw/tempdir/; +use File::Spec; + +my @parameters; +my @files; +my $tempdir = tempdir (CLEANUP => 1); + +while (@ARGV) +{ + my $arg = shift @ARGV; + if ($arg =~ /-o/) + { + push @parameters, $arg; + push @parameters, shift @ARGV; + next; + } + if ($arg =~ /\.[[:alnum:]]+$/i) {push @files, $arg} + else {push @parameters, $arg} +} + +my $index = 0; + +for my $file (@files) +{ + $file = File::Spec->rel2abs ($file); + my $tempfile = File::Spec->catfile ($tempdir, "$index.tif"); + my $mask = $file; + $mask =~ s/\.[[:alnum:]]+$/_mask.tif/i; + my $svg = $file; + $svg =~ s/\.[[:alnum:]]+$/.svg/i; + $file = $svg if (-e $svg); + if (-e $mask) + { + print STDERR "Using mask $mask\n"; + my $mask_old = File::Spec->catfile ($tempdir, 'mask_old.tif'); + my $mask_new = File::Spec->catfile ($tempdir, 'mask_new.tif'); + # extract existing alpha mask + system ('convert', $file, '-channel', 'matte', '-negate', '-separate', $mask_old); + # merge existing mask with file mask to create new mask + system ('composite', $mask_old, $mask, $mask, $mask_new); + # insert new mask into existing image + system ('composite', '-compose', 'CopyOpacity', $mask_new, $file, $tempfile); + push @parameters, $tempfile; + } + elsif ($file !~ /\.tif$/i) + { + print STDERR "Converting $file to TIFF\n"; + + # deal with imagemagick brokenness + my $curdir = File::Spec->curdir (); + $curdir = File::Spec->rel2abs ($curdir); + my ($v, $d, $f) = File::Spec->splitpath ($file); + my $basedir = File::Spec->catpath ($v, $d, ''); + chdir $basedir; + + system ('convert', '-background', 'transparent', $file, $tempfile); + chdir $curdir; + push @parameters, $tempfile; + } + else + { + push @parameters, $file; + } + $index++; +} + +system ('enfuse', @parameters); + +__END__ + +=head1 NAME + +enfuse-mask - Wrapper around enfuse for managing external masks + +=head1 Synopsis + + enfuse-mask [options] -o OUTPUT INPUTS + +=head1 DESCRIPTION + +Wrapper around enfuse. Usage is exactly the same as for enfuse, +except that if files named '<prefix>_mask.tif' exist, they are +inserted as alpha masks before fusing. + +Some examples of valid image pairs: + + image0000.tif image0000_mask.tif + foo.jpg foo_mask.tif + +Note masks can be any bit depth, but must have no alpha channel. Black +indicates areas to be ignored, any other colour indicates areas that may be +fused. + +Note also that only masks need to be TIFF files, input images can be any +filetype supported by ImageMagick. + +Requires enfuse and ImageMagick. + +L<http://enblend.sourceforge.net/> + +=head1 License + +This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version. + +=head1 See Also + +L<perl>, L<Panotools::Script> + +=head1 Author + +October 2006, Bruno Postle <bruno AT postle.net> + Property changes on: trunk/Panotools-Script/bin/enfuse-mask ___________________________________________________________________ Added: svn:executable + * This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bru...@us...> - 2009-07-12 14:06:20
|
Revision: 1006 http://panotools.svn.sourceforge.net/panotools/?rev=1006&view=rev Author: brunopostle Date: 2009-07-12 14:06:14 +0000 (Sun, 12 Jul 2009) Log Message: ----------- New ptodummy tool for creating missing input photos Modified Paths: -------------- trunk/Panotools-Script/Changes trunk/Panotools-Script/MANIFEST trunk/Panotools-Script/Makefile.PL trunk/Panotools-Script/dos/make_exe.pl Added Paths: ----------- trunk/Panotools-Script/bin/ptodummy Modified: trunk/Panotools-Script/Changes =================================================================== --- trunk/Panotools-Script/Changes 2009-07-10 07:44:34 UTC (rev 1005) +++ trunk/Panotools-Script/Changes 2009-07-12 14:06:14 UTC (rev 1006) @@ -4,6 +4,7 @@ - Add new projections to pod documentation and ptoinfo output - Add empty 'v' line to all output as panotools chokes without 'v' lines - New enfuse-mask tool based on enblend-mask + - New ptodummy tool for creating missing input photos 0.22 - Use ImageMagick to workaround matchpoint alpha channel bug Modified: trunk/Panotools-Script/MANIFEST =================================================================== --- trunk/Panotools-Script/MANIFEST 2009-07-10 07:44:34 UTC (rev 1005) +++ trunk/Panotools-Script/MANIFEST 2009-07-12 14:06:14 UTC (rev 1006) @@ -17,6 +17,7 @@ bin/process-masks-gui bin/ptocentre bin/ptoclean +bin/ptodummy bin/ptograph bin/ptoinfo bin/ptoinfo-gui Modified: trunk/Panotools-Script/Makefile.PL =================================================================== --- trunk/Panotools-Script/Makefile.PL 2009-07-10 07:44:34 UTC (rev 1005) +++ trunk/Panotools-Script/Makefile.PL 2009-07-12 14:06:14 UTC (rev 1006) @@ -6,7 +6,7 @@ 'EXE_FILES' => [ 'bin/cubic2erect', 'bin/erect2cubic', 'bin/pafextract', 'bin/jpeg2qtvr', 'bin/erect2qtvr', 'bin/enblend-mask', 'bin/match-n-shift', 'bin/ptoset', 'bin/process-masks', 'bin/erect2planet', 'bin/ptograph', 'bin/ptoget', 'bin/enfuse-mask', - 'bin/tif2svg', 'bin/enblend-svg', 'bin/ptoinfo', 'bin/ptopath', + 'bin/tif2svg', 'bin/enblend-svg', 'bin/ptoinfo', 'bin/ptopath', 'bin/ptodummy', 'bin/qtvr2erect-gui', 'bin/tif2svg-gui', 'bin/ptoinfo-gui', 'bin/ptosort', 'bin/ptovariable', 'bin/process-masks-gui', 'bin/enblend-svg-gui', 'bin/erect2qtvr-gui', 'bin/ptoclean', 'bin/erect2mercator', 'bin/ptosplit', 'bin/ptomerge', 'bin/panostart', 'bin/ptsed', 'bin/ptscluster', Added: trunk/Panotools-Script/bin/ptodummy =================================================================== --- trunk/Panotools-Script/bin/ptodummy (rev 0) +++ trunk/Panotools-Script/bin/ptodummy 2009-07-12 14:06:14 UTC (rev 1006) @@ -0,0 +1,74 @@ +#!/usr/bin/perl +use strict; +use warnings; +use Panotools::Script; +use File::Spec; +use File::Temp; +use Pod::Usage; + +my $path_pto = shift or pod2usage (-verbose => 2); + +my $pto = new Panotools::Script; +$pto->Read ($path_pto); + +for my $image (@{$pto->Image}) +{ + my $n = $image->{n}; + $n =~ s/"//g; + my ($v, $d, $path_photo) = File::Spec->splitpath ($n); + next if -e $path_photo; + + my $pnm = new File::Temp (UNLINK => 1, SUFFIX => '.pnm'); + my $r = 64 + int(rand(128)); + my $g = 64 + int(rand(128)); + my $b = 64 + int(rand(128)); + print $pnm "P3\n# CREATOR: $0\n1 1\n255\n$r\n$g\n$b"; + + next unless $image->{w} =~ /^[0-9]+$/; + next unless $image->{h} =~ /^[0-9]+$/; + system ('convert', + '-geometry', $image->{w}.'x'.$image->{h}.'!', + $pnm, $path_photo); +} + +__END__ + +=head1 NAME + +ptodummy - create missing input photos + +=head1 SYNOPSIS + + ptodummy project.pto + +=head1 DESCRIPTION + +B<ptodummy> takes a .pto project and creates missing input photos as +necessary. Each input photo is filled with a different colour to +help identify them in the hugin preview or in the stitched output. + +This is useful for debugging failing .pto projects submitted in bug +reports, as the original photos are not necessary to open and stitch +the project in hugin. + +The created images will always be placed in the current working +directory regardless of any paths specified in the project, +pre-existing files will not be clobbered. + +=head1 LICENSE + +This program is free software; you can redistribute it and/or +modify it under the terms of the GNU General Public License +as published by the Free Software Foundation; either version 2 +of the License, or (at your option) any later version. + +=head1 SEE ALSO + +L<http://hugin.sourceforge.net/> + +=head1 AUTHOR + +Bruno Postle - July 2009. + +=cut + Property changes on: trunk/Panotools-Script/bin/ptodummy ___________________________________________________________________ Added: svn:executable + * Modified: trunk/Panotools-Script/dos/make_exe.pl =================================================================== --- trunk/Panotools-Script/dos/make_exe.pl 2009-07-10 07:44:34 UTC (rev 1005) +++ trunk/Panotools-Script/dos/make_exe.pl 2009-07-12 14:06:14 UTC (rev 1006) @@ -21,6 +21,7 @@ process-masks ptocentre ptoclean +ptodummy ptoget ptograph ptoinfo This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bru...@us...> - 2009-07-12 14:08:43
|
Revision: 1007 http://panotools.svn.sourceforge.net/panotools/?rev=1007&view=rev Author: brunopostle Date: 2009-07-12 14:08:39 +0000 (Sun, 12 Jul 2009) Log Message: ----------- panostart: create default Makefile if no output specified Modified Paths: -------------- trunk/Panotools-Script/Changes trunk/Panotools-Script/bin/panostart Modified: trunk/Panotools-Script/Changes =================================================================== --- trunk/Panotools-Script/Changes 2009-07-12 14:06:14 UTC (rev 1006) +++ trunk/Panotools-Script/Changes 2009-07-12 14:08:39 UTC (rev 1007) @@ -5,6 +5,7 @@ - Add empty 'v' line to all output as panotools chokes without 'v' lines - New enfuse-mask tool based on enblend-mask - New ptodummy tool for creating missing input photos + - panostart: create default Makefile if no output specified 0.22 - Use ImageMagick to workaround matchpoint alpha channel bug Modified: trunk/Panotools-Script/bin/panostart =================================================================== --- trunk/Panotools-Script/bin/panostart 2009-07-12 14:06:14 UTC (rev 1006) +++ trunk/Panotools-Script/bin/panostart 2009-07-12 14:08:39 UTC (rev 1007) @@ -28,7 +28,8 @@ 'h|help' => \$help); pod2usage (-verbose => 2) if $help; -pod2usage (2) unless (defined $path_makefile and scalar @ARGV > 1); +pod2usage (2) unless scalar @ARGV > 1; +$path_makefile = 'Makefile' unless defined $path_makefile; my $groups = []; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bru...@us...> - 2009-08-15 12:17:45
|
Revision: 1035 http://panotools.svn.sourceforge.net/panotools/?rev=1035&view=rev Author: brunopostle Date: 2009-08-15 12:14:32 +0000 (Sat, 15 Aug 2009) Log Message: ----------- bump version to 0.23 Modified Paths: -------------- trunk/Panotools-Script/Changes trunk/Panotools-Script/lib/Panotools/Script.pm Modified: trunk/Panotools-Script/Changes =================================================================== --- trunk/Panotools-Script/Changes 2009-08-14 20:47:46 UTC (rev 1034) +++ trunk/Panotools-Script/Changes 2009-08-15 12:14:32 UTC (rev 1035) @@ -6,6 +6,7 @@ - New enfuse-mask tool based on enblend-mask - New ptodummy tool for creating missing input photos - panostart: create default Makefile if no output specified + - support 'i' line 'j' parameter introduced in gsoc layout project 0.22 - Use ImageMagick to workaround matchpoint alpha channel bug Modified: trunk/Panotools-Script/lib/Panotools/Script.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Script.pm 2009-08-14 20:47:46 UTC (rev 1034) +++ trunk/Panotools-Script/lib/Panotools/Script.pm 2009-08-15 12:14:32 UTC (rev 1035) @@ -36,7 +36,7 @@ use Storable qw/ dclone /; -our $VERSION = '0.22'; +our $VERSION = '0.23'; our $CLEANUP = 1; $CLEANUP = 0 if defined $ENV{DEBUG}; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bru...@us...> - 2009-09-07 20:28:35
|
Revision: 1043 http://panotools.svn.sourceforge.net/panotools/?rev=1043&view=rev Author: brunopostle Date: 2009-09-07 20:28:26 +0000 (Mon, 07 Sep 2009) Log Message: ----------- Bump version Modified Paths: -------------- trunk/Panotools-Script/Changes trunk/Panotools-Script/dos/make_exe.pl trunk/Panotools-Script/lib/Panotools/Script.pm Removed Paths: ------------- trunk/Panotools-Script/META.yml Modified: trunk/Panotools-Script/Changes =================================================================== --- trunk/Panotools-Script/Changes 2009-09-03 17:41:11 UTC (rev 1042) +++ trunk/Panotools-Script/Changes 2009-09-07 20:28:26 UTC (rev 1043) @@ -1,5 +1,7 @@ Revision history for Panotools::Script. +0.24 + 0.23 - Add new projections to pod documentation and ptoinfo output - Add empty 'v' line to all output as panotools chokes without 'v' lines Deleted: trunk/Panotools-Script/META.yml =================================================================== --- trunk/Panotools-Script/META.yml 2009-09-03 17:41:11 UTC (rev 1042) +++ trunk/Panotools-Script/META.yml 2009-09-07 20:28:26 UTC (rev 1043) @@ -1,23 +0,0 @@ -# http://module-build.sourceforge.net/META-spec.html -#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX# -name: Panotools-Script -version: 0.22 -version_from: lib/Panotools/Script.pm -installdirs: site -requires: - bytes: 0 - File::Copy: 1 - File::Spec: 0.8 - File::Temp: 0.1 - Getopt::Long: 2 - Getopt::Std: 1 - GraphViz: 1 - Image::ExifTool: 6 - Image::Size: 2.9 - Math::Trig: 0.1 - Pod::Usage: 1 - Storable: 2 - Test::More: 0.1 - -distribution_type: module -generated_by: ExtUtils::MakeMaker version 6.17 Modified: trunk/Panotools-Script/dos/make_exe.pl =================================================================== --- trunk/Panotools-Script/dos/make_exe.pl 2009-09-03 17:41:11 UTC (rev 1042) +++ trunk/Panotools-Script/dos/make_exe.pl 2009-09-07 20:28:26 UTC (rev 1043) @@ -9,6 +9,7 @@ cubic2erect enblend-mask enblend-svg +enfuse-mask erect2cubic erect2mercator erect2planet Modified: trunk/Panotools-Script/lib/Panotools/Script.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Script.pm 2009-09-03 17:41:11 UTC (rev 1042) +++ trunk/Panotools-Script/lib/Panotools/Script.pm 2009-09-07 20:28:26 UTC (rev 1043) @@ -36,7 +36,7 @@ use Storable qw/ dclone /; -our $VERSION = '0.23'; +our $VERSION = '0.24'; our $CLEANUP = 1; $CLEANUP = 0 if defined $ENV{DEBUG}; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bru...@us...> - 2009-09-16 18:14:53
|
Revision: 1049 http://panotools.svn.sourceforge.net/panotools/?rev=1049&view=rev Author: brunopostle Date: 2009-09-16 18:14:47 +0000 (Wed, 16 Sep 2009) Log Message: ----------- support for i-line Tx, Ty, Tz & Ts 'tilt' parameters in libpano13-2.9.15 Modified Paths: -------------- trunk/Panotools-Script/Changes trunk/Panotools-Script/lib/Panotools/Script/Line/Image.pm Modified: trunk/Panotools-Script/Changes =================================================================== --- trunk/Panotools-Script/Changes 2009-09-16 17:52:00 UTC (rev 1048) +++ trunk/Panotools-Script/Changes 2009-09-16 18:14:47 UTC (rev 1049) @@ -1,6 +1,7 @@ Revision history for Panotools::Script. 0.24 + - support for i-line Tx, Ty, Tz & Ts 'tilt' parameters in libpano13-2.9.15 0.23 - Add new projections to pod documentation and ptoinfo output Modified: trunk/Panotools-Script/lib/Panotools/Script/Line/Image.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Script/Line/Image.pm 2009-09-16 17:52:00 UTC (rev 1048) +++ trunk/Panotools-Script/lib/Panotools/Script/Line/Image.pm 2009-09-16 18:14:47 UTC (rev 1049) @@ -62,6 +62,9 @@ Rd Re + Tx,Ty,Tz Tilt on x axis, y axis, z axis + Ts Scaling of field of view in the tilt transformation + Vm vignetting correction mode (default 0): 0: no vignetting correction 1: radial vignetting correction (see j,k,l,o options) @@ -113,9 +116,9 @@ my $self = shift; } -sub _valid { return '^([abcdefghjnprtvwy]|[SCXYZ]|K[0-2][ab]|V[abcdfmxy]|Eev|E[rb]|R[abcde])(.*)' } +sub _valid { return '^([abcdefghjnprtvwy]|[SCXYZ]|K[0-2][ab]|V[abcdfmxy]|Eev|E[rb]|T[xyzs]|R[abcde])(.*)' } -sub _valid_ptoptimizer { return '^([abcdefghnprtvwySC])(.*)' } +sub _valid_ptoptimizer { return '^([abcdefghnprtvwySC]|T[xyzs])(.*)' } sub _sanitise_ptoptimizer { @@ -207,6 +210,7 @@ push @report, ['Format', $format]; push @report, ['Horizontal Field of View', $self->{v}]; push @report, ['Roll Pitch Yaw', $self->{r} .','. $self->{p} .','. $self->{y}]; + push @report, ['Tilt', $self->{Tx} .','. $self->{Ty} .','. $self->{Tz} .','. $self->{Ts}] if defined $self->{Ts}; push @report, ['Lens distortion', $self->{a} .','. $self->{b} .','. $self->{c}] if defined $self->{a}; push @report, ['Image centre', $self->{d} .','. $self->{e}] if defined $self->{d}; push @report, ['Image shear', $self->{g} .','. $self->{t}] if defined $self->{g}; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bru...@us...> - 2009-09-29 20:15:41
|
Revision: 1095 http://panotools.svn.sourceforge.net/panotools/?rev=1095&view=rev Author: brunopostle Date: 2009-09-29 20:15:28 +0000 (Tue, 29 Sep 2009) Log Message: ----------- Fix for crash in Subset() when project has no image metadata Modified Paths: -------------- trunk/Panotools-Script/Changes trunk/Panotools-Script/lib/Panotools/Script.pm Modified: trunk/Panotools-Script/Changes =================================================================== --- trunk/Panotools-Script/Changes 2009-09-28 18:13:14 UTC (rev 1094) +++ trunk/Panotools-Script/Changes 2009-09-29 20:15:28 UTC (rev 1095) @@ -3,6 +3,7 @@ 0.24 - support for i-line TiX, TiY, TiZ & TiS 'tilt' parameters in libpano13-2.9.15 - support for i-line TrX, TrY, TrZ 'XYZ transform' parameters in libpano13-2.9.15 + - Fix for crash in Subset() when project has no image metadata 0.23 - Add new projections to pod documentation and ptoinfo output Modified: trunk/Panotools-Script/lib/Panotools/Script.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Script.pm 2009-09-28 18:13:14 UTC (rev 1094) +++ trunk/Panotools-Script/lib/Panotools/Script.pm 2009-09-29 20:15:28 UTC (rev 1095) @@ -455,7 +455,8 @@ # copy metadata for selected image $pto_out->{imagemetadata}->[$mapping->{$index}] - = $self->{imagemetadata}->[$index]->Clone; + = $self->{imagemetadata}->[$index]->Clone + if defined $self->{imagemetadata}->[$index]; # copy selected image but resolve '=0' style references my $image = $self->{image}->[$index]->Clone; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bru...@us...> - 2009-10-16 22:03:15
|
Revision: 1110 http://panotools.svn.sourceforge.net/panotools/?rev=1110&view=rev Author: brunopostle Date: 2009-10-16 22:03:00 +0000 (Fri, 16 Oct 2009) Log Message: ----------- Split Makefile generator from panostart to Panotools::Makefile::Rule Modified Paths: -------------- trunk/Panotools-Script/Changes trunk/Panotools-Script/MANIFEST trunk/Panotools-Script/bin/panostart Added Paths: ----------- trunk/Panotools-Script/lib/Panotools/Makefile/ trunk/Panotools-Script/lib/Panotools/Makefile/Rule.pm Modified: trunk/Panotools-Script/Changes =================================================================== --- trunk/Panotools-Script/Changes 2009-10-15 08:28:43 UTC (rev 1109) +++ trunk/Panotools-Script/Changes 2009-10-16 22:03:00 UTC (rev 1110) @@ -4,6 +4,7 @@ - support for i-line TiX, TiY, TiZ & TiS 'tilt' parameters in libpano13-2.9.15 - support for i-line TrX, TrY, TrZ 'XYZ transform' parameters in libpano13-2.9.15 - Fix for crash in Subset() when project has no image metadata + - Split Makefile generator from panostart to Panotools::Makefile::Rule 0.23 - Add new projections to pod documentation and ptoinfo output Modified: trunk/Panotools-Script/MANIFEST =================================================================== --- trunk/Panotools-Script/MANIFEST 2009-10-15 08:28:43 UTC (rev 1109) +++ trunk/Panotools-Script/MANIFEST 2009-10-16 22:03:00 UTC (rev 1110) @@ -45,6 +45,7 @@ desktop/tif2svg-gui.desktop doc/match-n-shift.svg dos/make_exe.pl +lib/Panotools/Makefile/Rule.pm lib/Panotools/Matrix.pm lib/Panotools/Script.pm lib/Panotools/Script/Line.pm Modified: trunk/Panotools-Script/bin/panostart =================================================================== --- trunk/Panotools-Script/bin/panostart 2009-10-15 08:28:43 UTC (rev 1109) +++ trunk/Panotools-Script/bin/panostart 2009-10-16 22:03:00 UTC (rev 1110) @@ -6,6 +6,7 @@ use Getopt::Long; use Pod::Usage; use Panotools::Script; +use Panotools::Makefile::Rule; my $path_makefile; my $d_inc = 15; @@ -58,13 +59,13 @@ push (@{$groups}, $group_tmp); -my $rule_ptos = new File::Pto::Mk::Rule; +my $rule_ptos = new Panotools::Makefile::Rule; $rule_ptos->Targets ('pto'); -my $rule_mks = new File::Pto::Mk::Rule; +my $rule_mks = new Panotools::Makefile::Rule; $rule_mks->Targets ('mk'); -my $rule_imgs = new File::Pto::Mk::Rule; +my $rule_imgs = new Panotools::Makefile::Rule; $rule_imgs->Targets ('images'); -my $rule_movs = new File::Pto::Mk::Rule; +my $rule_movs = new Panotools::Makefile::Rule; $rule_movs->Targets ('qtvr'); my @rules_pto; @@ -106,7 +107,7 @@ print STDERR "$path_img: ". scalar @{$group} ." images\n" if $verbose; - my $rule_pto = new File::Pto::Mk::Rule; + my $rule_pto = new Panotools::Makefile::Rule; $rule_pto->Targets ("$stub.pto"); $rule_pto->Prerequisites (@{$group}); my @stacks = '--stacks'; @@ -120,28 +121,28 @@ push @rules_pto, $rule_pto; - my $rule_mk = new File::Pto::Mk::Rule; + my $rule_mk = new Panotools::Makefile::Rule; $rule_mk->Targets ("$stub.pto.mk"); $rule_mk->Prerequisites ("$stub.pto"); $rule_mk->Command ('pto2mk', '-o', "$stub.pto.mk", '-p', $stub, "$stub.pto"); push @rules_mk, $rule_mk; - my $rule_ldr_blended = new File::Pto::Mk::Rule; + my $rule_ldr_blended = new Panotools::Makefile::Rule; $rule_ldr_blended->Targets ($stub .".tif"); $rule_ldr_blended->Prerequisites ("$stub.pto", "$stub.pto.mk", @{$group}); $rule_ldr_blended->Command ('make', '-e', '-f', "$stub.pto.mk", $stub .".tif", '$(MAKE_EXTRA_ARGS)'); push @rules_ldr_blended, $rule_ldr_blended; - my $rule_ldr_stacked_blended = new File::Pto::Mk::Rule; + my $rule_ldr_stacked_blended = new Panotools::Makefile::Rule; $rule_ldr_stacked_blended->Targets ($stub ."_fused.tif"); $rule_ldr_stacked_blended->Prerequisites ("$stub.pto", "$stub.pto.mk", @{$group}); $rule_ldr_stacked_blended->Command ('make', '-e', '-f', "$stub.pto.mk", $stub ."_fused.tif", '$(MAKE_EXTRA_ARGS)'); push @rules_ldr_stacked_blended, $rule_ldr_stacked_blended; - my $rule_ldr_blended_equirect = new File::Pto::Mk::Rule; + my $rule_ldr_blended_equirect = new Panotools::Makefile::Rule; $rule_ldr_blended_equirect->Targets ("$stub.mov", "$stub-sky.jpg", "$stub-planet.jpg", "$stub-mercator.jpg"); $rule_ldr_blended_equirect->Prerequisites ("$stub.pto", "$stub.pto.mk", "$stub.tif"); $rule_ldr_blended_equirect->Command ('make', '-e', '-f', '$(HUGINDATADIR)/Makefile.equirect.mk', @@ -150,7 +151,7 @@ push @rules_ldr_blended_equirect, $rule_ldr_blended_equirect; my $stub_f = $stub .'_fused'; - my $rule_ldr_stacked_blended_equirect = new File::Pto::Mk::Rule; + my $rule_ldr_stacked_blended_equirect = new Panotools::Makefile::Rule; $rule_ldr_stacked_blended_equirect->Targets ("$stub_f.mov", "$stub_f-sky.jpg", "$stub_f-planet.jpg", "$stub_f-mercator.jpg"); $rule_ldr_stacked_blended_equirect->Prerequisites ("$stub.pto", "$stub.pto.mk", "$stub_f.tif"); $rule_ldr_stacked_blended_equirect->Command ('make', '-e', '-f', '$(HUGINDATADIR)/Makefile.equirect.mk', @@ -158,7 +159,7 @@ push @rules_ldr_stacked_blended_equirect, $rule_ldr_stacked_blended_equirect; - my $rule_hdr_blended = new File::Pto::Mk::Rule; + my $rule_hdr_blended = new Panotools::Makefile::Rule; $rule_hdr_blended->Targets ($stub ."_hdr.exr"); $rule_hdr_blended->Prerequisites ("$stub.pto", "$stub.pto.mk", @{$group}); $rule_hdr_blended->Command ('make', '-e', '-f', "$stub.pto.mk", $stub ."_hdr.exr", '$(MAKE_EXTRA_ARGS)'); @@ -166,15 +167,15 @@ push @rules_hdr_blended, $rule_hdr_blended; } -my $rule_all = new File::Pto::Mk::Rule; +my $rule_all = new Panotools::Makefile::Rule; $rule_all->Targets ('all'); $rule_all->Prerequisites ('images'); -my $rule_phony = new File::Pto::Mk::Rule; +my $rule_phony = new Panotools::Makefile::Rule; $rule_phony->Targets ('.PHONY'); $rule_phony->Prerequisites (qw/all images pto mk/); -my $rule_self = new File::Pto::Mk::Rule; +my $rule_self = new Panotools::Makefile::Rule; $rule_self->Targets ($path_makefile); $rule_self->Prerequisites (@ARGV); $rule_self->Command ($0, @argv_save); @@ -219,58 +220,6 @@ return 1; } -package File::Pto::Mk::Rule; -use strict; -use warnings; - -sub new -{ - my $class = shift; - $class = ref $class || $class; - my $self = bless {targets => [], prerequisites => [], command => []}, $class; - return $self; -} - -sub Assemble -{ - my $self = shift; - return 0 unless scalar @{$self->{targets}}; - - my $text; - $text .= join ' ', (map { _quoteshell ($_)} @{$self->{targets}}); - $text .= ' : '; - $text .= join ' ', (map { _quoteshell ($_)} @{$self->{prerequisites}}); - $text .= "\n\t" if scalar @{$self->{command}}; - $text .= join ' ', (map { _quoteshell ($_)} @{$self->{command}}); - $text .= "\n\n"; - return $text; -} - -sub Targets -{ - my $self = shift; - push @{$self->{targets}}, @_; -} - -sub Prerequisites -{ - my $self = shift; - push @{$self->{prerequisites}}, @_; -} - -sub Command -{ - my $self = shift; - push @{$self->{command}}, @_; -} - -sub _quoteshell -{ - my $string = shift; - $string =~ s/(['"\[\] `&*+~#:<?>|])/\\$1/g; - return $string; -} - __END__ =head1 NAME Added: trunk/Panotools-Script/lib/Panotools/Makefile/Rule.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Makefile/Rule.pm (rev 0) +++ trunk/Panotools-Script/lib/Panotools/Makefile/Rule.pm 2009-10-16 22:03:00 UTC (rev 1110) @@ -0,0 +1,122 @@ +package Panotools::Makefile::Rule; + +=head1 NAME + +Panotools::Makefile::Rule - Assemble Makefile rules + +=head1 SYNOPSIS + +Simple interface for generating Makefile syntax + +=head1 DESCRIPTION + +Writing Makefiles directly from perl scripts with print and "\t" etc... is +prone to error, this library provides a simple perl interface for assembling +Makefile rules. + +=cut + +use strict; +use warnings; + +=head1 USAGE + + my $rule = new Panotools::Makefile::Rule; + +=cut + +sub new +{ + my $class = shift; + $class = ref $class || $class; + my $self = bless {targets => [], prerequisites => [], command => []}, $class; + return $self; +} + +=pod + +A Makefile rule always has one or more 'targets', these are typically +filenames, but can be 'phony' non-files. + +(phony targets should be listed as perequisites of the special .PHONY target) + + $rule->Targets ('output1.txt', 'output2.txt'); + +..or equivalently: + + $rule->Targets ('output1.txt'); + $rule->Targets ('output2.txt'); + +=cut + +sub Targets +{ + my $self = shift; + push @{$self->{targets}}, @_; +} + +=pod + +Rules can have zero or more 'prerequisites', again these are typically +filenames, but can be 'phony' non-files. + + $rule->Prerequisites ('input1.txt', 'input2.txt'); + +..or equivalently: + + $rule->Prerequisites ('input1.txt'); + $rule->Prerequisites ('input2.txt'); + +=cut + +sub Prerequisites +{ + my $self = shift; + push @{$self->{prerequisites}}, @_; +} + +=pod + +Rules have an optional 'command': + + $rule->Command ('cp', 'input1.txt', 'output1.txt', ';', 'cp', 'input2.txt', 'output2.txt'); + +=cut + +sub Command +{ + my $self = shift; + push @{$self->{command}}, @_; +} + +=pod + +Assemble all this into string that can be written to a Makefile: + + my $string = $rule->Assemble; + +=cut + +sub Assemble +{ + my $self = shift; + return 0 unless scalar @{$self->{targets}}; + + my $text; + $text .= join ' ', (map { _quoteshell ($_)} @{$self->{targets}}); + $text .= ' : '; + $text .= join ' ', (map { _quoteshell ($_)} @{$self->{prerequisites}}); + $text .= "\n\t" if scalar @{$self->{command}}; + $text .= join ' ', (map { _quoteshell ($_)} @{$self->{command}}); + $text .= "\n\n"; + return $text; +} + +sub _quoteshell +{ + my $string = shift; + $string =~ s/(['"\[\] `&*+~#:<?>|])/\\$1/g; + return $string; +} + +1; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bru...@us...> - 2009-10-17 22:37:58
|
Revision: 1113 http://panotools.svn.sourceforge.net/panotools/?rev=1113&view=rev Author: brunopostle Date: 2009-10-17 22:37:52 +0000 (Sat, 17 Oct 2009) Log Message: ----------- Tests for Makefile rule generator, probably fails on Windows Modified Paths: -------------- trunk/Panotools-Script/MANIFEST Added Paths: ----------- trunk/Panotools-Script/t/101.makerule.t Modified: trunk/Panotools-Script/MANIFEST =================================================================== --- trunk/Panotools-Script/MANIFEST 2009-10-17 22:36:37 UTC (rev 1112) +++ trunk/Panotools-Script/MANIFEST 2009-10-17 22:37:52 UTC (rev 1113) @@ -76,6 +76,7 @@ t/031.matrix.t t/032.image.t t/033.points.t +t/101.makerule.t t/data/cemetery/dscn4905.jpg t/data/cemetery/dscn4906.jpg t/data/cemetery/dscn4907.jpg Added: trunk/Panotools-Script/t/101.makerule.t =================================================================== --- trunk/Panotools-Script/t/101.makerule.t (rev 0) +++ trunk/Panotools-Script/t/101.makerule.t 2009-10-17 22:37:52 UTC (rev 1113) @@ -0,0 +1,82 @@ +#!/usr/bin/perl +#Editor vim:syn=perl + +use strict; +use warnings; +use Test::More 'no_plan'; +use File::Temp qw/tempdir/; +use File::Spec; +use lib 'lib'; + +use Panotools::Makefile::Rule; +for my $file ('foo', +'foo#bar', +'foo bar', +'fooübar', +'fooébar', +'foo°bar', +'foo|bar', +'foo^bar', +'foo<bar', +'foo>bar', +'foo&bar', +'foo!bar', +'foo,bar', +'foo_bar', +'foo.bar', +'foo-bar', +'foo{bar', +'foo}bar', +'foo*bar', +'foo+bar', +'foo@bar', +'foo"bar', +'foo[bar', +'foo]bar', +'foo`bar', +'foo~bar', +'foo?bar', +"foo'bar", +'foo(bar', +'foo)bar', +'foo%bar' +) +{ + ok (testfilename ($file)); +} + +#'foo$(FOO)bar', +#'foo${FOO}bar', +#'foo/bar', +#'foo=bar', +#'foo\bar', +#'foo;bar', +#'foo:bar', +#'foo$bar', + +sub testfilename +{ + my $filename = shift; + my $filename_out = $filename . '_out'; + + my $rule = new Panotools::Makefile::Rule; + + $rule->Targets ($filename_out); + $rule->Prerequisites ($filename); + $rule->Command ('cp', $filename, $filename_out); + + my $tempdir = tempdir (CLEANUP => 1); + my $file = File::Spec->catfile ($tempdir, $filename); + open FILE, ">", $file; + close FILE; + + my $makefile = File::Spec->catfile ($tempdir, 'Makefile'); + open MAKE, ">", $makefile; + print MAKE $rule->Assemble; + close MAKE; + chdir $tempdir; + system ('make'); + return 1 if -e $filename_out; + print $rule->Assemble; + return 0; +} This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bru...@us...> - 2009-10-31 22:37:51
|
Revision: 1121 http://panotools.svn.sourceforge.net/panotools/?rev=1121&view=rev Author: brunopostle Date: 2009-10-31 22:37:43 +0000 (Sat, 31 Oct 2009) Log Message: ----------- erect2cubic --face option to optionally specify cubeface pixel size Modified Paths: -------------- trunk/Panotools-Script/Changes trunk/Panotools-Script/bin/erect2cubic Modified: trunk/Panotools-Script/Changes =================================================================== --- trunk/Panotools-Script/Changes 2009-10-24 21:43:11 UTC (rev 1120) +++ trunk/Panotools-Script/Changes 2009-10-31 22:37:43 UTC (rev 1121) @@ -5,6 +5,7 @@ - support for i-line TrX, TrY, TrZ 'XYZ transform' parameters in libpano13-2.9.15 - Fix for crash in Subset() when project has no image metadata - Split Makefile generator from panostart to Panotools::Makefile::Rule + - erect2cubic --face option to optionally specify cubeface pixel size 0.23 - Add new projections to pod documentation and ptoinfo output Modified: trunk/Panotools-Script/bin/erect2cubic =================================================================== --- trunk/Panotools-Script/bin/erect2cubic 2009-10-24 21:43:11 UTC (rev 1120) +++ trunk/Panotools-Script/bin/erect2cubic 2009-10-31 22:37:43 UTC (rev 1121) @@ -25,6 +25,7 @@ --roll (degrees) --pitch (degrees, use -90 if nadir is in centre) --yaw (degrees, adjust position of first cubeface) + --face (cubeface size in pixels, defaults to optimum) "; my $roll = $opts->{'--roll'} || 0; @@ -36,7 +37,7 @@ my ($width, $height) = imgsize ($erect); -my $face = 8 * int ($width / 3.14159265 / 8); +my $face = $opts->{'--face'} || 8 * int ($width / 3.14159265 / 8); my $p = new Panotools::Script; $p->Panorama->Set (v => 90, f => 0, u => 0, w => $face, h => $face, n => "\"$filespec\""); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bru...@us...> - 2009-11-01 23:07:02
|
Revision: 1123 http://panotools.svn.sourceforge.net/panotools/?rev=1123&view=rev Author: brunopostle Date: 2009-11-01 23:06:49 +0000 (Sun, 01 Nov 2009) Log Message: ----------- Some more Makefile rule fixes Modified Paths: -------------- trunk/Panotools-Script/lib/Panotools/Makefile/Rule.pm trunk/Panotools-Script/t/101.makerule.t Modified: trunk/Panotools-Script/lib/Panotools/Makefile/Rule.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Makefile/Rule.pm 2009-10-31 22:40:23 UTC (rev 1122) +++ trunk/Panotools-Script/lib/Panotools/Makefile/Rule.pm 2009-11-01 23:06:49 UTC (rev 1123) @@ -53,7 +53,7 @@ { my $self = shift; push @{$self->{targets}}, @_; - die 'Error: unescapable =;:$ in targets: '. join (' ', @_) if grep /[=;:\$]/, @_; + warn 'Error: unescapable =;: in targets: '. join (' ', @_) if grep /[=;:]/, @_; #warn 'Warning: non-portable target name: '. join (' ', @_) if grep /[?<>:*|"^]/, @_; } @@ -75,13 +75,13 @@ { my $self = shift; push @{$self->{prerequisites}}, @_; - die 'Error: unescapable =;:$ in prerequisites: '. join (' ', @_) if grep /[=;:\$]/, @_; + warn 'Error: unescapable =;: in prerequisites: '. join (' ', @_) if grep /[=;:]/, @_; #warn 'Warning: non-portable target name: '. join (' ', @_) if grep /[?<>:*|"^]/, @_; } =pod -Rules have optional 'commands': +Rules zero or more 'commands': $rule->Command ('cp', 'input1.txt', 'output1.txt'); $rule->Command ('cp', 'input2.txt', 'output2.txt'); @@ -137,9 +137,22 @@ sub _quoteshell { my $string = shift; - $string =~ s/(['"() `&*+^~<?>|])/\\$1/g; - # unquote $(FOO) variables - $string =~ s/\$\\\(([^)]+)\\\)/\$($1)/g; + if ($^O =~ /^(MSWin|dos)/) + { + # ?<>:*|"^ are unusable in Windows filenames + # so the only thing we can quote is a space + $string =~ s/^(.* .*)$/"$1"/g; + } + else + { + # some shell char sequences are real shell commands + unless ($string =~ /^([&<>|]|2>|\|\||&&|2>&1|`.+`)$/) + { + $string =~ s/(['"() `&*<?>|])/\\$1/g; + # unquote $(FOO) variables + $string =~ s/\$\\\(([^)]+)\\\)/\$($1)/g; + } + } return $string; } Modified: trunk/Panotools-Script/t/101.makerule.t =================================================================== --- trunk/Panotools-Script/t/101.makerule.t 2009-10-31 22:40:23 UTC (rev 1122) +++ trunk/Panotools-Script/t/101.makerule.t 2009-11-01 23:06:49 UTC (rev 1123) @@ -15,10 +15,6 @@ 'fooübar', 'fooébar', 'foo°bar', -'foo|bar', -'foo^bar', -'foo<bar', -'foo>bar', 'foo&bar', 'foo!bar', 'foo,bar', @@ -27,15 +23,12 @@ 'foo-bar', 'foo{bar', 'foo}bar', -'foo*bar', 'foo+bar', 'foo@bar', -'foo"bar', 'foo[bar', 'foo]bar', 'foo`bar', 'foo~bar', -'foo?bar', "foo'bar", 'foo(bar', 'foo)bar', @@ -45,6 +38,20 @@ ok (testfilename ($file)); } +# filenames that will never work on Windows +for my $file ('foo', +'foo?bar', +'foo<bar', +'foo>bar', +'foo*bar', +'foo|bar', +'foo"bar', +'foo^bar' +) +{ + ok (testfilename ($file)) unless ($^O =~ /^(MSWin|dos)/); +} + #'foo$(FOO)bar', #'foo${FOO}bar', #'foo/bar', This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bru...@us...> - 2009-11-03 23:32:14
|
Revision: 1125 http://panotools.svn.sourceforge.net/panotools/?rev=1125&view=rev Author: brunopostle Date: 2009-11-03 23:32:03 +0000 (Tue, 03 Nov 2009) Log Message: ----------- More refactoring and tests... Modified Paths: -------------- trunk/Panotools-Script/Changes trunk/Panotools-Script/MANIFEST trunk/Panotools-Script/bin/panostart trunk/Panotools-Script/lib/Panotools/Makefile/Rule.pm trunk/Panotools-Script/lib/Panotools/Makefile.pm Added Paths: ----------- trunk/Panotools-Script/lib/Panotools/Makefile/Variable.pm trunk/Panotools-Script/lib/Panotools/Photos.pm trunk/Panotools-Script/t/104.metachars.t trunk/Panotools-Script/t/105.vars.t Modified: trunk/Panotools-Script/Changes =================================================================== --- trunk/Panotools-Script/Changes 2009-11-02 21:11:16 UTC (rev 1124) +++ trunk/Panotools-Script/Changes 2009-11-03 23:32:03 UTC (rev 1125) @@ -5,6 +5,7 @@ - support for i-line TrX, TrY, TrZ 'XYZ transform' parameters in libpano13-2.9.15 - Fix for crash in Subset() when project has no image metadata - Split Makefile generator from panostart to Panotools::Makefile::Rule + - Split utilities for querying list of photos to Panotools::Photos - erect2cubic --face option to optionally specify cubeface pixel size 0.23 Modified: trunk/Panotools-Script/MANIFEST =================================================================== --- trunk/Panotools-Script/MANIFEST 2009-11-02 21:11:16 UTC (rev 1124) +++ trunk/Panotools-Script/MANIFEST 2009-11-03 23:32:03 UTC (rev 1125) @@ -47,7 +47,9 @@ dos/make_exe.pl lib/Panotools/Makefile.pm lib/Panotools/Makefile/Rule.pm +lib/Panotools/Makefile/Variable.pm lib/Panotools/Matrix.pm +lib/Panotools/Photos.pm lib/Panotools/Script.pm lib/Panotools/Script/Line.pm lib/Panotools/Script/Line/Control.pm @@ -80,6 +82,8 @@ t/101.makerule.t t/102.platform.t t/103.platform.t +t/104.metachars.t +t/105.vars.t t/data/cemetery/dscn4905.jpg t/data/cemetery/dscn4906.jpg t/data/cemetery/dscn4907.jpg Modified: trunk/Panotools-Script/bin/panostart =================================================================== --- trunk/Panotools-Script/bin/panostart 2009-11-02 21:11:16 UTC (rev 1124) +++ trunk/Panotools-Script/bin/panostart 2009-11-03 23:32:03 UTC (rev 1125) @@ -7,6 +7,8 @@ use Pod::Usage; use Panotools::Script; use Panotools::Makefile::Rule; +use Panotools::Makefile::Variable; +use Panotools::Photos; my $path_makefile; my $d_inc = 15; @@ -18,6 +20,7 @@ my $nostacks = 0; my @argv_save = @ARGV; +my @makefile; GetOptions ('o|output=s' => \$path_makefile, 't|time=s' => \$d_inc, @@ -68,6 +71,17 @@ my $rule_movs = new Panotools::Makefile::Rule; $rule_movs->Targets ('qtvr'); +# define some variables + +my $make_extra_args = new Panotools::Makefile::Variable ('MAKE_EXTRA_ARGS', 'shell'); +$make_extra_args->Values ('clean'); + +my $hugindatadir = new Panotools::Makefile::Variable ('HUGINDATADIR', 'shell'); +$hugindatadir->Values ('/usr/share/hugin'); + +my $ap_extra_args = new Panotools::Makefile::Variable ('AP_EXTRA_ARGS', 'shell'); +$ap_extra_args->Values ('--clean'); + my @rules_pto; my @rules_mk; my @rules_ldr_blended; @@ -78,45 +92,43 @@ for my $group (@{$groups}) { - next if scalar @{$group} == 1; + my $temp_images = new Panotools::Photos (@{$group}); + next if scalar $temp_images->Paths == 1; - my $a = $group->[0]; - my $b = $group->[-1]; - $a =~ s/\.[[:alnum:]]+$//; - $b =~ s/\.[[:alnum:]]+$//; - $b =~ s/.*[\/\\]//; - my $stub = "$a-$b"; + my $stub = $temp_images->Stub; $rule_ptos->Prerequisites ("$stub.pto"); $rule_mks->Prerequisites ("$stub.pto.mk"); my $path_img; my $path_mov; - if (is_stacks (@{$group})) + + if ($nostacks or $temp_images->Bracketed == 0) { - $path_img = $stub ."_fused.tif"; - $path_mov = $stub ."_fused.mov"; + $path_img = $stub .".tif"; + $path_mov = $stub .".mov"; } else { - $path_img = $stub .".tif"; - $path_mov = $stub .".mov"; + $path_img = $stub ."_fused.tif"; + $path_mov = $stub ."_fused.mov"; } + $rule_imgs->Prerequisites ($path_img); $rule_movs->Prerequisites ($path_mov); - print STDERR "$path_img: ". scalar @{$group} ." images\n" if $verbose; + print STDERR "$path_img: ". scalar $temp_images->Paths ." images\n" if $verbose; my $rule_pto = new Panotools::Makefile::Rule; $rule_pto->Targets ("$stub.pto"); - $rule_pto->Prerequisites (@{$group}); + $rule_pto->Prerequisites ($temp_images->Paths); my @command = ('match-n-shift'); push @command, ('--stacks') unless $nostacks; push @command, ('--align', '$(AP_EXTRA_ARGS)', '--output', "$stub.pto"); push @command, ('--projection', $projection) if defined $projection; push @command, ('--fov', $deg_fov) if defined $deg_fov; push @command, ('--selection', $crop_s) if defined $crop_s; - $rule_pto->Command (@command, @{$group}); + $rule_pto->Command (@command, $temp_images->Paths); push @rules_pto, $rule_pto; @@ -128,40 +140,40 @@ push @rules_mk, $rule_mk; my $rule_ldr_blended = new Panotools::Makefile::Rule; - $rule_ldr_blended->Targets ($stub .".tif"); - $rule_ldr_blended->Prerequisites ("$stub.pto", "$stub.pto.mk", @{$group}); - $rule_ldr_blended->Command ('make', '-e', '-f', "$stub.pto.mk", $stub .".tif", '$(MAKE_EXTRA_ARGS)'); + $rule_ldr_blended->Targets ("$stub.tif"); + $rule_ldr_blended->Prerequisites ("$stub.pto", "$stub.pto.mk", $temp_images->Paths); + $rule_ldr_blended->Command ('$(MAKE)', '-e', '-f', "$stub.pto.mk", "$stub.tif", '$(MAKE_EXTRA_ARGS)'); push @rules_ldr_blended, $rule_ldr_blended; + my $stub_f = $stub .'_fused'; my $rule_ldr_stacked_blended = new Panotools::Makefile::Rule; - $rule_ldr_stacked_blended->Targets ($stub ."_fused.tif"); - $rule_ldr_stacked_blended->Prerequisites ("$stub.pto", "$stub.pto.mk", @{$group}); - $rule_ldr_stacked_blended->Command ('make', '-e', '-f', "$stub.pto.mk", $stub ."_fused.tif", '$(MAKE_EXTRA_ARGS)'); + $rule_ldr_stacked_blended->Targets ("$stub_f.tif"); + $rule_ldr_stacked_blended->Prerequisites ("$stub.pto", "$stub.pto.mk", $temp_images->Paths); + $rule_ldr_stacked_blended->Command ('$(MAKE)', '-e', '-f', "$stub.pto.mk", "$stub_f.tif", '$(MAKE_EXTRA_ARGS)'); push @rules_ldr_stacked_blended, $rule_ldr_stacked_blended; my $rule_ldr_blended_equirect = new Panotools::Makefile::Rule; $rule_ldr_blended_equirect->Targets ("$stub.mov", "$stub-sky.jpg", "$stub-planet.jpg", "$stub-mercator.jpg"); $rule_ldr_blended_equirect->Prerequisites ("$stub.pto", "$stub.pto.mk", "$stub.tif"); - $rule_ldr_blended_equirect->Command ('make', '-e', '-f', '$(HUGINDATADIR)/Makefile.equirect.mk', + $rule_ldr_blended_equirect->Command ('$(MAKE)', '-e', '-f', '$(HUGINDATADIR)/Makefile.equirect.mk', 'equirect_all', 'equirect_clean', "PTO=$stub.pto", 'FUSED_SUFFIX='); push @rules_ldr_blended_equirect, $rule_ldr_blended_equirect; - my $stub_f = $stub .'_fused'; my $rule_ldr_stacked_blended_equirect = new Panotools::Makefile::Rule; $rule_ldr_stacked_blended_equirect->Targets ("$stub_f.mov", "$stub_f-sky.jpg", "$stub_f-planet.jpg", "$stub_f-mercator.jpg"); $rule_ldr_stacked_blended_equirect->Prerequisites ("$stub.pto", "$stub.pto.mk", "$stub_f.tif"); - $rule_ldr_stacked_blended_equirect->Command ('make', '-e', '-f', '$(HUGINDATADIR)/Makefile.equirect.mk', + $rule_ldr_stacked_blended_equirect->Command ('$(MAKE)', '-e', '-f', '$(HUGINDATADIR)/Makefile.equirect.mk', 'equirect_all', 'equirect_clean', "PTO=$stub.pto", 'FUSED_SUFFIX=_fused'); push @rules_ldr_stacked_blended_equirect, $rule_ldr_stacked_blended_equirect; my $rule_hdr_blended = new Panotools::Makefile::Rule; $rule_hdr_blended->Targets ($stub ."_hdr.exr"); - $rule_hdr_blended->Prerequisites ("$stub.pto", "$stub.pto.mk", @{$group}); - $rule_hdr_blended->Command ('make', '-e', '-f', "$stub.pto.mk", $stub ."_hdr.exr", '$(MAKE_EXTRA_ARGS)'); + $rule_hdr_blended->Prerequisites ("$stub.pto", "$stub.pto.mk", $temp_images->Paths); + $rule_hdr_blended->Command ('$(MAKE)', '-e', '-f', "$stub.pto.mk", $stub ."_hdr.exr", '$(MAKE_EXTRA_ARGS)'); push @rules_hdr_blended, $rule_hdr_blended; } @@ -179,46 +191,17 @@ $rule_self->Prerequisites (@ARGV); $rule_self->Command ($0, @argv_save); -open MAKE, ">", $path_makefile or die "cannot write-open $path_makefile"; +push @makefile, $rule_phony, $rule_all, $rule_ptos, $rule_mks, $rule_imgs, $rule_movs; +push @makefile, $make_extra_args, $hugindatadir, $ap_extra_args; +push @makefile, @rules_pto, @rules_mk, @rules_ldr_blended, @rules_ldr_stacked_blended, + @rules_ldr_blended_equirect, @rules_ldr_stacked_blended_equirect, @rules_hdr_blended; +push @makefile, $rule_self; +open MAKE, ">", $path_makefile or die "cannot write-open $path_makefile"; print MAKE "# Created by Panotools::Script $Panotools::Script::VERSION\n"; -print MAKE $rule_phony->Assemble; -print MAKE $rule_all->Assemble; -print MAKE $rule_ptos->Assemble; -print MAKE $rule_mks->Assemble; -print MAKE $rule_imgs->Assemble; -print MAKE $rule_movs->Assemble; -print MAKE "MAKE_EXTRA_ARGS=clean\n"; -print MAKE "HUGINDATADIR=/usr/share/hugin\n"; -print MAKE "AP_EXTRA_ARGS=--clean\n\n"; -print MAKE map {$_->Assemble} @rules_pto; -print MAKE map {$_->Assemble} @rules_mk; -print MAKE map {$_->Assemble} @rules_ldr_blended; -print MAKE map {$_->Assemble} @rules_ldr_stacked_blended; -print MAKE map {$_->Assemble} @rules_ldr_blended_equirect; -print MAKE map {$_->Assemble} @rules_ldr_stacked_blended_equirect; -print MAKE map {$_->Assemble} @rules_hdr_blended; -print MAKE $rule_self->Assemble; - +print MAKE map {$_->Assemble} @makefile; close MAKE; -sub is_stacks -{ - return 0 if $nostacks; - my $speeds = {}; - for my $path_photo (@_) - { - my $exif_info = Image::ExifTool::ImageInfo ($path_photo, 'ExposureTime', 'ShutterSpeed'); - my $et = $exif_info->{ExposureTime} || $exif_info->{ShutterSpeed} || 0; - $speeds->{$et} = 'TRUE'; - } - - my $brackets = scalar keys (%{$speeds}); - return 0 if (scalar (@_) % $brackets); - return 0 if ($brackets < 2); - return 1; -} - __END__ =head1 NAME Modified: trunk/Panotools-Script/lib/Panotools/Makefile/Rule.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Makefile/Rule.pm 2009-11-02 21:11:16 UTC (rev 1124) +++ trunk/Panotools-Script/lib/Panotools/Makefile/Rule.pm 2009-11-03 23:32:03 UTC (rev 1125) @@ -19,7 +19,7 @@ use strict; use warnings; -use Panotools::Makefile qw/platform/; +use Panotools::Makefile qw/quotetarget quoteprerequisite quoteshell/; =head1 USAGE @@ -110,59 +110,16 @@ return 0 unless scalar @{$self->{targets}}; my $text; - $text .= join ' ', (map { _quotetargets ($_)} @{$self->{targets}}); + $text .= join ' ', (map { quotetarget ($_)} @{$self->{targets}}); $text .= ' : '; - $text .= join ' ', (map { _quoteprerequisites ($_)} @{$self->{prerequisites}}); + $text .= join ' ', (map { quoteprerequisite ($_)} @{$self->{prerequisites}}); for my $command (@{$self->{command}}) { $text .= "\n\t"; - $text .= join ' ', (map { _quoteshell ($_)} @{$command}); + $text .= join ' ', (map { quoteshell ($_)} @{$command}); } $text .= "\n\n"; return $text; } -sub _quotetargets -{ - my $string = shift; - # Transform all C:\foo\bar paths to C:/foo/bar - $string =~ s/\\/\//g if (platform =~ /^(MSWin|dos)/); - $string =~ s/([ #|\\])/\\$1/g; - return $string; -} - -sub _quoteprerequisites -{ - my $string = shift; - # Transform all C:\foo\bar paths to C:/foo/bar - $string =~ s/\\/\//g if (platform =~ /^(MSWin|dos)/); - $string =~ s/([ #|\\])/\\$1/g; - return $string; -} - -sub _quoteshell -{ - my $string = shift; - if (platform =~ /^(MSWin|dos)/) - { - # ?<>:*|"^ are unusable in Windows filenames - # so the only thing we can quote is a space - $string =~ s/^(.* .*)$/"$1"/g; - # Transform all C:\foo\bar paths to C:/foo/bar - $string =~ s/\\/\//g; - } - else - { - # some shell char sequences are useful shell commands - # others are automatic variables $(<D) $(<F) $< - unless ($string =~ /^([&<>|]|2>|\|\||&&|2>&1|`.+`|\$\(<D\)|\$\(<F\)|\$<)$/) - { - $string =~ s/([#'"() `&<>|\\])/\\$1/g; - # unquote $(FOO) variables - $string =~ s/\$\\\(([^)]+)\\\)/\$($1)/g; - } - } - return $string; -} - 1; Added: trunk/Panotools-Script/lib/Panotools/Makefile/Variable.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Makefile/Variable.pm (rev 0) +++ trunk/Panotools-Script/lib/Panotools/Makefile/Variable.pm 2009-11-03 23:32:03 UTC (rev 1125) @@ -0,0 +1,127 @@ +package Panotools::Makefile::Variable; + +=head1 NAME + +Panotools::Makefile::Variable - Assemble Makefile Variable definitions + +=head1 SYNOPSIS + +Simple interface for generating Makefile syntax + +=head1 DESCRIPTION + +Writing Makefiles directly from perl scripts with print and "\t" etc... is +prone to error, this library provides a simple perl interface for assembling +Makefiles. + +=cut + +use strict; +use warnings; + +use Panotools::Makefile qw/quotetarget quoteprerequisite quoteshell/; + +=head1 USAGE + + my $var = new Panotools::Makefile::Variable; + +..or define the 'variable name' and quoting style at the same time: + + my $var = new Panotools::Makefile::Variable ('USERS', 'shell'); + +=cut + +sub new +{ + my $class = shift; + $class = ref $class || $class; + my $self = bless {name => shift, value => [], quoting => shift}, $class; + return $self; +} + +=pod + +Set or query the name: + + $var->Name ('USERS'); + $text = $var->Name; + +=cut + +sub Name +{ + my $self = shift; + $self->{name} = shift if @_; + return $self->{name}; +} + +=pod + + $var->Values ('James Brine', 'George Loveless'); + $var->Values ('Thomas Standfield'); + +=cut + +sub Values +{ + my $self = shift; + push @{$self->{value}}, @_; + return $self->{value}; +} + +=pod + +By default spaces and special characters in values will be quoted/escaped +suitably for use within a Makefile 'command', other valid quoting styles are +'prerequisite' and 'target': + + $var->Quoting ('target'); + +(See L<Panotools::Makefile> for description of quoting styles) + +The variable name should not require escaping and should consist of safe +letters, numbers and the underscore: A-Z a-z 0-9 _ + +=cut + +sub Quoting +{ + my $self = shift; + $self->{quoting} = shift if @_; + return $self->{quoting}; +} + +=pod + +Construct a text fragment that defines this variable suitable for use in a +Makefile like so: + + $text = $var->Assemble; + +=cut + +sub Assemble +{ + my $self = shift; + return 0 unless defined $self->{name}; + + my $text; + $text .= quotetarget ($self->{name}); + $text .= ' = '; + if ($self->{quoting} eq 'target') + { + $text .= join ' ', (map { quotetarget ($_)} @{$self->{value}}); + } + elsif ($self->{quoting} eq 'prerequisite') + { + $text .= join ' ', (map { quoteprerequisite ($_)} @{$self->{value}}); + } + else + { + $text .= join ' ', (map { quoteshell ($_)} @{$self->{value}}); + } + $text .= "\n"; + return $text; +} + +1; Modified: trunk/Panotools-Script/lib/Panotools/Makefile.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Makefile.pm 2009-11-02 21:11:16 UTC (rev 1124) +++ trunk/Panotools-Script/lib/Panotools/Makefile.pm 2009-11-03 23:32:03 UTC (rev 1125) @@ -22,13 +22,13 @@ use Exporter; use vars qw /@ISA @EXPORT_OK/; @ISA = qw /Exporter/; -@EXPORT_OK = qw /platform/; +@EXPORT_OK = qw /platform quotetarget quoteprerequisite quoteshell/; our $PLATFORM; =head1 USAGE - use Panotools::Makefile qw/platform/; + use Panotools::Makefile qw/platform quotetarget quoteprerequisite quoteshell/; Access the current platform name (MSWin32, linux, etc...): @@ -52,4 +52,76 @@ return $^O; } +=pod + +Take a text string (typically a single filename or path) and quote/escape +spaces and special characters to make it suitable for use as a Makefile +'target' or 'prerequisite': + + $escaped_target = quotetarget ('My Filename.txt'); + $escaped_prerequisite = quoteprerequisite ('My Filename.txt'); + +Note that the =;:%$ characters are not usable as filenames, they may be used as +control characters in a target or prerequisite. An exception is the : in +Windows paths such as C:\WINDOWS which is understood by gnu make. + +Additionally the ?<>*|"^\ characters are not portable across filesystems (e.g. +USB sticks, CDs, Windows) and should be avoided in filenames. + +=cut + +sub quotetarget +{ + my $string = shift; + # Transform all C:\foo\bar paths to C:/foo/bar + $string =~ s/\\/\//g if (platform =~ /^(MSWin|dos)/); + $string =~ s/([ #|\\])/\\$1/g; + return $string; +} + +sub quoteprerequisite +{ + my $string = shift; + # Transform all C:\foo\bar paths to C:/foo/bar + $string =~ s/\\/\//g if (platform =~ /^(MSWin|dos)/); + $string =~ s/([ #|\\])/\\$1/g; + return $string; +} + +=pod + +Take a text string, typically a command-line token, and quote/escape spaces and +special characters to make it suitable for use in a Makefile command: + + $escaped_token = quoteshell ('Hello World'); + +=cut + +sub quoteshell +{ + my $string = shift; + if (platform =~ /^(MSWin|dos)/) + { + # ?<>:*|"^ are unusable in Windows filenames, + # other unix shell characters are unspecial in Windows + # so the only thing we can quote is a space + $string = '"'.$string.'"' if $string =~ / /; + # Transform all C:\foo\bar paths to C:/foo/bar + # Not all token are file paths, so \:-) will become /:-) + $string =~ s/\\/\//g; + } + else + { + # some shell char sequences are useful shell commands + # others are automatic variables $(<D) $(<F) $< + unless ($string =~ /^([&<>|]|2>|\|\||&&|2>&1|`.+`|\$\(<D\)|\$\(<F\)|\$<)$/) + { + $string =~ s/([#'"() `&<>|\\])/\\$1/g; + # unquote $(FOO) variables + $string =~ s/\$\\\(([^)]+)\\\)/\$($1)/g; + } + } + return $string; +} + 1; Added: trunk/Panotools-Script/lib/Panotools/Photos.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Photos.pm (rev 0) +++ trunk/Panotools-Script/lib/Panotools/Photos.pm 2009-11-03 23:32:03 UTC (rev 1125) @@ -0,0 +1,112 @@ +package Panotools::Photos; + +=head1 NAME + +Panotools::Photos - Photo groups + +=head1 SYNOPSIS + +Query lists of photos + +=head1 DESCRIPTION + +A collection of photos has possiblities, it could be one or more panoramas or a +bracketed set. This module provides some methods for describing grups of +photos based on available metadata + +=cut + +use strict; +use warnings; + +use File::Spec; +use Image::ExifTool; + +=head1 USAGE + +=cut + +sub new +{ + my $class = shift; + $class = ref $class || $class; + my $self = bless {images => [@_]}, $class; + return $self; +} + +=pod + +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->{images}->[0]; + my $path_b = $self->{images}->[-1]; + # strip any suffixes + $path_a =~ s/\.[[:alnum:]]+$//; + $path_b =~ s/\.[[:alnum:]]+$//; + # strip all but filename + $path_b =~ s/.*[\/\\]//; + return $path_a .'-'. $path_b; +} + +=pod + +Add to or get the list of image filenames: + + $photos->Paths ('DSC_0001.JPG', 'DSC_0002.JPG'); + my @paths = $photos->Paths; + +=cut + +sub Paths +{ + my $self = shift; + push @{$self->{images}}, @_; + return @{$self->{images}}; +} + +=pod + +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); + +Note this can't tell the difference between a single bracketed stack and a +series of photos taken on auto-exposure. + +=cut + +sub Bracketed +{ + my $self = shift; + my $speeds = {}; + for my $path_photo ($self->Paths) + { + my $exif_info = Image::ExifTool::ImageInfo ($path_photo, 'ExposureTime', 'ShutterSpeed'); + my $et = $exif_info->{ExposureTime} || $exif_info->{ShutterSpeed} || 0; + $speeds->{$et} = 'TRUE'; + } + + my $brackets = scalar keys (%{$speeds}); + return 0 if (scalar (@_) % $brackets); + return 0 if ($brackets < 2); + return 1; +} + +sub SplitDate +{ + my $self = shift; + # TODO +} + +1; Added: trunk/Panotools-Script/t/104.metachars.t =================================================================== --- trunk/Panotools-Script/t/104.metachars.t (rev 0) +++ trunk/Panotools-Script/t/104.metachars.t 2009-11-03 23:32:03 UTC (rev 1125) @@ -0,0 +1,28 @@ +#!/usr/bin/perl +#Editor vim:syn=perl + +use strict; +use warnings; +use Test::More 'no_plan'; +use lib 'lib'; + +use Panotools::Makefile::Rule; +use Panotools::Makefile qw/platform/; +ok (1); + +my $rule = new Panotools::Makefile::Rule; + +$rule->Targets ('%.1'); +$rule->Prerequisites ('%.pod'); +$rule->Command ('pod2man', '--center', '$(PACKAGE)', '--release', '$(PACKAGE_VERSION)', '$<', '$@'); +$rule->Command ('echo', '`uname -a`', '>', '$(TMPDIR)/foo'); +$rule->Command ('uname', '-a', '>', '${TMPDIR}/bar', '&&', 'echo', '" ### (woo!) ### "'); + +platform ('linux'); + +print $rule->Assemble; + +ok ($rule->Assemble =~ /%.1 : %.pod/); +ok ($rule->Assemble =~ /\tpod2man --center \$\(PACKAGE\) --release \$\(PACKAGE_VERSION\) \$< \$@/); +ok ($rule->Assemble =~ /\techo `uname -a` > \$\(TMPDIR\)\/foo/); +ok ($rule->Assemble =~ /\tuname -a > \${TMPDIR}\/bar && echo \\"\\ \\#\\#\\#\\ \\\(woo!\\\)\\ \\#\\#\\#\\ \\"/); Added: trunk/Panotools-Script/t/105.vars.t =================================================================== --- trunk/Panotools-Script/t/105.vars.t (rev 0) +++ trunk/Panotools-Script/t/105.vars.t 2009-11-03 23:32:03 UTC (rev 1125) @@ -0,0 +1,43 @@ +#!/usr/bin/perl +#Editor vim:syn=perl + +use strict; +use warnings; +use Test::More 'no_plan'; +use lib 'lib'; + +use Panotools::Makefile::Variable; +use Panotools::Makefile qw/platform/; +ok (1); + +my $var = new Panotools::Makefile::Variable; + +$var->Name ('USERS'); + +$var->Values ('James Brine', 'George Loveless'); +$var->Values ('Thomas Standfield'); +$var->Quoting ('shell'); + +platform ('MSWin32'); + +ok ($var->Assemble =~ /USERS = "James Brine" "George Loveless" "Thomas Standfield"/); + +platform ('linux'); + +ok ($var->Assemble =~ /USERS = James\\ Brine George\\ Loveless Thomas\\ Standfield/); + +undef $var; + +my $var2 = new Panotools::Makefile::Variable ('USERS', 'shell'); + +$var2->Values ('James Brine', 'George Loveless'); +$var2->Values ('Thomas Standfield'); + +platform ('MSWin32'); + +ok ($var2->Assemble =~ /USERS = "James Brine" "George Loveless" "Thomas Standfield"/); + +platform ('linux'); + +ok ($var2->Assemble =~ /USERS = James\\ Brine George\\ Loveless Thomas\\ Standfield/); + This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bru...@us...> - 2009-11-04 18:25:24
|
Revision: 1126 http://panotools.svn.sourceforge.net/panotools/?rev=1126&view=rev Author: brunopostle Date: 2009-11-04 18:25:08 +0000 (Wed, 04 Nov 2009) Log Message: ----------- More escaping, $ and # should work in filenames Modified Paths: -------------- trunk/Panotools-Script/lib/Panotools/Makefile.pm trunk/Panotools-Script/t/101.makerule.t trunk/Panotools-Script/t/104.metachars.t Modified: trunk/Panotools-Script/lib/Panotools/Makefile.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Makefile.pm 2009-11-03 23:32:03 UTC (rev 1125) +++ trunk/Panotools-Script/lib/Panotools/Makefile.pm 2009-11-04 18:25:08 UTC (rev 1126) @@ -14,6 +14,9 @@ prone to error, this library provides a simple perl interface for assembling Makefile rules. +See L<Panotools::Makefile::Rule> and L<Panotools::Makefile::Variable> for +object classes that you can use to contruct makefiles. + =cut use strict; @@ -61,10 +64,21 @@ $escaped_target = quotetarget ('My Filename.txt'); $escaped_prerequisite = quoteprerequisite ('My Filename.txt'); -Note that the =;:%$ characters are not usable as filenames, they may be used as +Note that the =;:% characters are not usable as filenames, they may be used as control characters in a target or prerequisite. An exception is the : in Windows paths such as C:\WINDOWS which is understood by gnu make. +* and ? are wildcards and will be expanded. You may find that it is +possible to use these as actual characters in filenames, but this assumption +will lead to subtle errors. + +$ can be used in a filename, but when used with brackets, ${FOO} or $(BAR), +will be substituted as a make variable. + +Targets starting with . are special make targets and not usable as filenames, +the workaround is to supply a full path instead of a relative path. i.e: +/foo/bar/.hugin rather than .hugin + Additionally the ?<>*|"^\ characters are not portable across filesystems (e.g. USB sticks, CDs, Windows) and should be avoided in filenames. @@ -76,6 +90,8 @@ # Transform all C:\foo\bar paths to C:/foo/bar $string =~ s/\\/\//g if (platform =~ /^(MSWin|dos)/); $string =~ s/([ #|\\])/\\$1/g; + # escape $ as $$ unless part of a $(VARIABLE) + $string =~ s/\$([^({]|$)/\$\$$1/g; return $string; } @@ -85,6 +101,8 @@ # Transform all C:\foo\bar paths to C:/foo/bar $string =~ s/\\/\//g if (platform =~ /^(MSWin|dos)/); $string =~ s/([ #|\\])/\\$1/g; + # escape $ as $$ unless part of a $(VARIABLE) + $string =~ s/\$([^({]|$)/\$\$$1/g; return $string; } @@ -107,18 +125,26 @@ # so the only thing we can quote is a space $string = '"'.$string.'"' if $string =~ / /; # Transform all C:\foo\bar paths to C:/foo/bar - # Not all token are file paths, so \:-) will become /:-) + # Not all tokens are file paths, so \:-) will become /:-) $string =~ s/\\/\//g; + # hash is parsed by make as a comment, backslash escape + $string =~ s/#/\\#/g; + # escape $ as $$ unless part of a $(VARIABLE) + $string =~ s/\$([^({]|$)/\$\$$1/g; } else { # some shell char sequences are useful shell commands # others are automatic variables $(<D) $(<F) $< - unless ($string =~ /^([&<>|]|2>|\|\||&&|2>&1|`.+`|\$\(<D\)|\$\(<F\)|\$<)$/) + unless ($string =~ /^([&<>|]|2>|\|\||&&|2>&1|`[^`]+`)$/ + or $string =~ /^(\$\(<D\)|\$\(<F\)|\$<|\$@|\$%|\$\?|\$\^|\$\+|\$\||\$\*)$/) { - $string =~ s/([#'"() `&<>|\\])/\\$1/g; - # unquote $(FOO) variables + # backslash escape shell characters + $string =~ s/([!#'"() `&<>|\\])/\\$1/g; + # unquote $(FOO) variables escaped above $string =~ s/\$\\\(([^)]+)\\\)/\$($1)/g; + # double escape $ as \$$ unless part of a $(VARIABLE) + $string =~ s/\$([^({]|$)/\\\$\$$1/g; } } return $string; Modified: trunk/Panotools-Script/t/101.makerule.t =================================================================== --- trunk/Panotools-Script/t/101.makerule.t 2009-11-03 23:32:03 UTC (rev 1125) +++ trunk/Panotools-Script/t/101.makerule.t 2009-11-04 18:25:08 UTC (rev 1126) @@ -10,6 +10,7 @@ use Panotools::Makefile::Rule; for my $file ('foo', +'Westward Ho!', 'foo#bar', 'foo bar', 'fooübar', @@ -32,6 +33,9 @@ "foo'bar", 'foo(bar', 'foo)bar', +'foo$bar', +'$bar', +'bar$', '#bar', ' bar', 'übar', @@ -59,7 +63,7 @@ } # filenames that will never work on Windows -for my $file ('foo', +for my $file ( 'foo?bar', 'foo<bar', 'foo>bar', @@ -72,15 +76,18 @@ ok (testfilename ($file)) unless ($^O =~ /^(MSWin|dos)/); } + +# Should be ok, but need different tests +#'foo/bar', +#'foo\bar', + +# make syntax can't be used in filenames #'foo$(FOO)bar', #'foo${FOO}bar', -#'foo/bar', #'foo=bar', #'foo%bar', -#'foo\bar', #'foo;bar', #'foo:bar', -#'foo$bar', #'.bar', #'%bar', Modified: trunk/Panotools-Script/t/104.metachars.t =================================================================== --- trunk/Panotools-Script/t/104.metachars.t 2009-11-03 23:32:03 UTC (rev 1125) +++ trunk/Panotools-Script/t/104.metachars.t 2009-11-04 18:25:08 UTC (rev 1126) @@ -25,4 +25,4 @@ ok ($rule->Assemble =~ /%.1 : %.pod/); ok ($rule->Assemble =~ /\tpod2man --center \$\(PACKAGE\) --release \$\(PACKAGE_VERSION\) \$< \$@/); ok ($rule->Assemble =~ /\techo `uname -a` > \$\(TMPDIR\)\/foo/); -ok ($rule->Assemble =~ /\tuname -a > \${TMPDIR}\/bar && echo \\"\\ \\#\\#\\#\\ \\\(woo!\\\)\\ \\#\\#\\#\\ \\"/); +ok ($rule->Assemble =~ /\tuname -a > \${TMPDIR}\/bar && echo \\"\\ \\#\\#\\#\\ \\\(woo\\!\\\)\\ \\#\\#\\#\\ \\"/); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bru...@us...> - 2009-11-04 21:15:03
|
Revision: 1127 http://panotools.svn.sourceforge.net/panotools/?rev=1127&view=rev Author: brunopostle Date: 2009-11-04 21:14:54 +0000 (Wed, 04 Nov 2009) Log Message: ----------- Some refactoring of panostart Modified Paths: -------------- trunk/Panotools-Script/bin/panostart trunk/Panotools-Script/lib/Panotools/Photos.pm Modified: trunk/Panotools-Script/bin/panostart =================================================================== --- trunk/Panotools-Script/bin/panostart 2009-11-04 18:25:08 UTC (rev 1126) +++ trunk/Panotools-Script/bin/panostart 2009-11-04 21:14:54 UTC (rev 1127) @@ -2,7 +2,6 @@ use strict; use warnings; -use Image::ExifTool; use Getopt::Long; use Pod::Usage; use Panotools::Script; @@ -35,33 +34,14 @@ pod2usage (2) unless scalar @ARGV > 1; $path_makefile = 'Makefile' unless defined $path_makefile; -my $groups = []; +my $rule_phony = new Panotools::Makefile::Rule; +$rule_phony->Targets ('.PHONY'); +$rule_phony->Prerequisites (qw/all images pto mk/); -my $group_tmp = []; -my $previous_time; -my $previous_inc = 0; -for my $path_photo (@ARGV) -{ - my $exif_info = Image::ExifTool::ImageInfo ($path_photo); - my $datetime = $exif_info->{'FileModificationDateTime'}; - $datetime = $exif_info->{'DateTimeOriginal'} if (defined $exif_info->{'DateTimeOriginal'}); - my $time_unix = Image::ExifTool::GetUnixTime ($datetime); - $previous_time = $time_unix unless (defined $previous_time); - my $inc = $time_unix - $previous_time; +my $rule_all = new Panotools::Makefile::Rule; +$rule_all->Targets ('all'); +$rule_all->Prerequisites ('images'); - if (($inc - $previous_inc) > $d_inc) - { - push (@{$groups}, $group_tmp); - $group_tmp = []; - } - push @{$group_tmp}, $path_photo; - - $previous_time = $time_unix; - $previous_inc = $inc; -} -push (@{$groups}, $group_tmp); - - my $rule_ptos = new Panotools::Makefile::Rule; $rule_ptos->Targets ('pto'); my $rule_mks = new Panotools::Makefile::Rule; @@ -71,7 +51,7 @@ my $rule_movs = new Panotools::Makefile::Rule; $rule_movs->Targets ('qtvr'); -# define some variables +push @makefile, $rule_phony, $rule_all, $rule_ptos, $rule_mks, $rule_imgs, $rule_movs; my $make_extra_args = new Panotools::Makefile::Variable ('MAKE_EXTRA_ARGS', 'shell'); $make_extra_args->Values ('clean'); @@ -82,6 +62,8 @@ my $ap_extra_args = new Panotools::Makefile::Variable ('AP_EXTRA_ARGS', 'shell'); $ap_extra_args->Values ('--clean'); +push @makefile, $make_extra_args, $hugindatadir, $ap_extra_args; + my @rules_pto; my @rules_mk; my @rules_ldr_blended; @@ -90,45 +72,40 @@ my @rules_ldr_blended_equirect; my @rules_ldr_stacked_blended_equirect; -for my $group (@{$groups}) +my $all_photos = new Panotools::Photos (@ARGV); + +for my $photo_set ($all_photos->SplitInterval ($d_inc)) { - my $temp_images = new Panotools::Photos (@{$group}); - next if scalar $temp_images->Paths == 1; + next if scalar $photo_set->Paths == 1; - my $stub = $temp_images->Stub; + my $stub = $photo_set->Stub; $rule_ptos->Prerequisites ("$stub.pto"); $rule_mks->Prerequisites ("$stub.pto.mk"); - my $path_img; - my $path_mov; - - if ($nostacks or $temp_images->Bracketed == 0) + if ($nostacks or $photo_set->Bracketed == 0) { - $path_img = $stub .".tif"; - $path_mov = $stub .".mov"; + $rule_imgs->Prerequisites ($stub .".tif"); + $rule_movs->Prerequisites ($stub .".mov"); + print STDERR $stub .".tif: ". scalar $photo_set->Paths ." images\n" if $verbose; } else { - $path_img = $stub ."_fused.tif"; - $path_mov = $stub ."_fused.mov"; + $rule_imgs->Prerequisites ($stub ."_fused.tif"); + $rule_movs->Prerequisites ($stub ."_fused.mov"); + print STDERR $stub ."_fused.tif: ". scalar $photo_set->Paths ." images\n" if $verbose; } - $rule_imgs->Prerequisites ($path_img); - $rule_movs->Prerequisites ($path_mov); - - print STDERR "$path_img: ". scalar $temp_images->Paths ." images\n" if $verbose; - my $rule_pto = new Panotools::Makefile::Rule; $rule_pto->Targets ("$stub.pto"); - $rule_pto->Prerequisites ($temp_images->Paths); + $rule_pto->Prerequisites ($photo_set->Paths); my @command = ('match-n-shift'); push @command, ('--stacks') unless $nostacks; push @command, ('--align', '$(AP_EXTRA_ARGS)', '--output', "$stub.pto"); push @command, ('--projection', $projection) if defined $projection; push @command, ('--fov', $deg_fov) if defined $deg_fov; push @command, ('--selection', $crop_s) if defined $crop_s; - $rule_pto->Command (@command, $temp_images->Paths); + $rule_pto->Command (@command, $photo_set->Paths); push @rules_pto, $rule_pto; @@ -141,7 +118,7 @@ my $rule_ldr_blended = new Panotools::Makefile::Rule; $rule_ldr_blended->Targets ("$stub.tif"); - $rule_ldr_blended->Prerequisites ("$stub.pto", "$stub.pto.mk", $temp_images->Paths); + $rule_ldr_blended->Prerequisites ("$stub.pto", "$stub.pto.mk", $photo_set->Paths); $rule_ldr_blended->Command ('$(MAKE)', '-e', '-f', "$stub.pto.mk", "$stub.tif", '$(MAKE_EXTRA_ARGS)'); push @rules_ldr_blended, $rule_ldr_blended; @@ -149,7 +126,7 @@ my $stub_f = $stub .'_fused'; my $rule_ldr_stacked_blended = new Panotools::Makefile::Rule; $rule_ldr_stacked_blended->Targets ("$stub_f.tif"); - $rule_ldr_stacked_blended->Prerequisites ("$stub.pto", "$stub.pto.mk", $temp_images->Paths); + $rule_ldr_stacked_blended->Prerequisites ("$stub.pto", "$stub.pto.mk", $photo_set->Paths); $rule_ldr_stacked_blended->Command ('$(MAKE)', '-e', '-f', "$stub.pto.mk", "$stub_f.tif", '$(MAKE_EXTRA_ARGS)'); push @rules_ldr_stacked_blended, $rule_ldr_stacked_blended; @@ -172,29 +149,20 @@ my $rule_hdr_blended = new Panotools::Makefile::Rule; $rule_hdr_blended->Targets ($stub ."_hdr.exr"); - $rule_hdr_blended->Prerequisites ("$stub.pto", "$stub.pto.mk", $temp_images->Paths); + $rule_hdr_blended->Prerequisites ("$stub.pto", "$stub.pto.mk", $photo_set->Paths); $rule_hdr_blended->Command ('$(MAKE)', '-e', '-f', "$stub.pto.mk", $stub ."_hdr.exr", '$(MAKE_EXTRA_ARGS)'); push @rules_hdr_blended, $rule_hdr_blended; } -my $rule_all = new Panotools::Makefile::Rule; -$rule_all->Targets ('all'); -$rule_all->Prerequisites ('images'); +push @makefile, @rules_pto, @rules_mk, @rules_ldr_blended, @rules_ldr_stacked_blended, + @rules_ldr_blended_equirect, @rules_ldr_stacked_blended_equirect, @rules_hdr_blended; -my $rule_phony = new Panotools::Makefile::Rule; -$rule_phony->Targets ('.PHONY'); -$rule_phony->Prerequisites (qw/all images pto mk/); - my $rule_self = new Panotools::Makefile::Rule; $rule_self->Targets ($path_makefile); $rule_self->Prerequisites (@ARGV); $rule_self->Command ($0, @argv_save); -push @makefile, $rule_phony, $rule_all, $rule_ptos, $rule_mks, $rule_imgs, $rule_movs; -push @makefile, $make_extra_args, $hugindatadir, $ap_extra_args; -push @makefile, @rules_pto, @rules_mk, @rules_ldr_blended, @rules_ldr_stacked_blended, - @rules_ldr_blended_equirect, @rules_ldr_stacked_blended_equirect, @rules_hdr_blended; push @makefile, $rule_self; open MAKE, ">", $path_makefile or die "cannot write-open $path_makefile"; Modified: trunk/Panotools-Script/lib/Panotools/Photos.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Photos.pm 2009-11-04 18:25:08 UTC (rev 1126) +++ trunk/Panotools-Script/lib/Panotools/Photos.pm 2009-11-04 21:14:54 UTC (rev 1127) @@ -2,16 +2,16 @@ =head1 NAME -Panotools::Photos - Photo groups +Panotools::Photos - Photo sets =head1 SYNOPSIS -Query lists of photos +Query sets of photos =head1 DESCRIPTION -A collection of photos has possiblities, it could be one or more panoramas or a -bracketed set. This module provides some methods for describing grups of +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 @@ -24,6 +24,14 @@ =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'); + =cut sub new @@ -36,6 +44,22 @@ =pod +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; + push @{$self->{images}}, @_; + return @{$self->{images}}; +} + +=pod + Construct a stub filename from the names of the first and last images in the list. @@ -60,22 +84,6 @@ =pod -Add to or get the list of image filenames: - - $photos->Paths ('DSC_0001.JPG', 'DSC_0002.JPG'); - my @paths = $photos->Paths; - -=cut - -sub Paths -{ - my $self = shift; - push @{$self->{images}}, @_; - return @{$self->{images}}; -} - -=pod - 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: @@ -103,10 +111,47 @@ return 1; } -sub SplitDate +=pod + +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); + +=cut + +sub SplitInterval { my $self = shift; - # TODO + my $d_inc = shift; + my @groups; + + my $group_tmp = new Panotools::Photos; + my $previous_time; + my $previous_inc = 0; + for my $path_photo ($self->Paths) + { + my $exif_info = Image::ExifTool::ImageInfo ($path_photo); + my $datetime = $exif_info->{'FileModificationDateTime'}; + $datetime = $exif_info->{'DateTimeOriginal'} if (defined $exif_info->{'DateTimeOriginal'}); + 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; + $group_tmp = new Panotools::Photos; + } + $group_tmp->Paths ($path_photo); + + $previous_time = $time_unix; + $previous_inc = $inc; + } + push @groups, $group_tmp; + return @groups; } 1; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bru...@us...> - 2009-11-05 23:35:08
|
Revision: 1129 http://panotools.svn.sourceforge.net/panotools/?rev=1129&view=rev Author: brunopostle Date: 2009-11-05 23:34:56 +0000 (Thu, 05 Nov 2009) Log Message: ----------- Some more tests for Panotools::Photos Modified Paths: -------------- trunk/Panotools-Script/lib/Panotools/Photos.pm trunk/Panotools-Script/t/data/cemetery/dscn4905.jpg trunk/Panotools-Script/t/data/cemetery/dscn4906.jpg trunk/Panotools-Script/t/data/cemetery/dscn4907.jpg trunk/Panotools-Script/t/data/cemetery/dscn4908.jpg trunk/Panotools-Script/t/data/cemetery/dscn4909.jpg Added Paths: ----------- trunk/Panotools-Script/t/106.photos.t Modified: trunk/Panotools-Script/lib/Panotools/Photos.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Photos.pm 2009-11-04 22:39:59 UTC (rev 1128) +++ trunk/Panotools-Script/lib/Panotools/Photos.pm 2009-11-05 23:34:56 UTC (rev 1129) @@ -154,4 +154,30 @@ return @groups; } +=pod + +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 $path_photo = $self->{images}->[$index]; + my $exif_info = Image::ExifTool::ImageInfo ($path_photo); + my $fov = $exif_info->{'FOV'}; + $fov =~ s/[^0-9.]*$// if defined $fov; + return $fov; +} + 1; Added: trunk/Panotools-Script/t/106.photos.t =================================================================== --- trunk/Panotools-Script/t/106.photos.t (rev 0) +++ trunk/Panotools-Script/t/106.photos.t 2009-11-05 23:34:56 UTC (rev 1129) @@ -0,0 +1,29 @@ +#!/usr/bin/perl +#Editor vim:syn=perl + +use strict; +use warnings; +use Test::More 'no_plan'; +use lib 'lib'; + +use Panotools::Photos; +ok (1); + +my $photos = new Panotools::Photos ('t/data/cemetery/dscn4905.jpg', 't/data/cemetery/dscn4906.jpg'); +ok (scalar ($photos->Paths) == 2); + +$photos->Paths ('t/data/cemetery/dscn4907.jpg', 't/data/cemetery/dscn4908.jpg', 't/data/cemetery/dscn4909.jpg'); +ok (scalar ($photos->Paths) == 5); + +ok ($photos->Stub eq 't/data/cemetery/dscn4905-dscn4909'); + +ok ($photos->Bracketed == 0); + +ok ($photos->FOV == 54.4); +ok ($photos->FOV (0) == 54.4); +ok ($photos->FOV (-1) == 54.4); + +# this one deosn't have any EXIF info +$photos = new Panotools::Photos ('t/data/equirectangular/equirectangular.jpg'); +ok (defined $photos->FOV == 0); + Modified: trunk/Panotools-Script/t/data/cemetery/dscn4905.jpg =================================================================== (Binary files differ) Modified: trunk/Panotools-Script/t/data/cemetery/dscn4906.jpg =================================================================== (Binary files differ) Modified: trunk/Panotools-Script/t/data/cemetery/dscn4907.jpg =================================================================== (Binary files differ) Modified: trunk/Panotools-Script/t/data/cemetery/dscn4908.jpg =================================================================== (Binary files differ) Modified: trunk/Panotools-Script/t/data/cemetery/dscn4909.jpg =================================================================== (Binary files differ) This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bru...@us...> - 2009-11-05 23:43:36
|
Revision: 1130 http://panotools.svn.sourceforge.net/panotools/?rev=1130&view=rev Author: brunopostle Date: 2009-11-05 23:43:21 +0000 (Thu, 05 Nov 2009) Log Message: ----------- Some more refactoring. panostart now gets FoV from EXIF data Modified Paths: -------------- trunk/Panotools-Script/Changes trunk/Panotools-Script/MANIFEST trunk/Panotools-Script/bin/panostart trunk/Panotools-Script/lib/Panotools/Makefile/Rule.pm trunk/Panotools-Script/lib/Panotools/Makefile/Variable.pm trunk/Panotools-Script/lib/Panotools/Makefile.pm trunk/Panotools-Script/t/102.platform.t trunk/Panotools-Script/t/103.platform.t trunk/Panotools-Script/t/104.metachars.t trunk/Panotools-Script/t/105.vars.t Added Paths: ----------- trunk/Panotools-Script/lib/Panotools/Makefile/Utils.pm Modified: trunk/Panotools-Script/Changes =================================================================== --- trunk/Panotools-Script/Changes 2009-11-05 23:34:56 UTC (rev 1129) +++ trunk/Panotools-Script/Changes 2009-11-05 23:43:21 UTC (rev 1130) @@ -4,7 +4,8 @@ - support for i-line TiX, TiY, TiZ & TiS 'tilt' parameters in libpano13-2.9.15 - support for i-line TrX, TrY, TrZ 'XYZ transform' parameters in libpano13-2.9.15 - Fix for crash in Subset() when project has no image metadata - - Split Makefile generator from panostart to Panotools::Makefile::Rule + - Split Makefile generator from panostart to Panotools::Makefile + - panostart will get FoV from EXIF data - Split utilities for querying list of photos to Panotools::Photos - erect2cubic --face option to optionally specify cubeface pixel size Modified: trunk/Panotools-Script/MANIFEST =================================================================== --- trunk/Panotools-Script/MANIFEST 2009-11-05 23:34:56 UTC (rev 1129) +++ trunk/Panotools-Script/MANIFEST 2009-11-05 23:43:21 UTC (rev 1130) @@ -48,6 +48,7 @@ lib/Panotools/Makefile.pm lib/Panotools/Makefile/Rule.pm lib/Panotools/Makefile/Variable.pm +lib/Panotools/Makefile/Utils.pm lib/Panotools/Matrix.pm lib/Panotools/Photos.pm lib/Panotools/Script.pm @@ -84,6 +85,7 @@ t/103.platform.t t/104.metachars.t t/105.vars.t +t/106.photos.t t/data/cemetery/dscn4905.jpg t/data/cemetery/dscn4906.jpg t/data/cemetery/dscn4907.jpg Modified: trunk/Panotools-Script/bin/panostart =================================================================== --- trunk/Panotools-Script/bin/panostart 2009-11-05 23:34:56 UTC (rev 1129) +++ trunk/Panotools-Script/bin/panostart 2009-11-05 23:43:21 UTC (rev 1130) @@ -5,8 +5,7 @@ use Getopt::Long; use Pod::Usage; use Panotools::Script; -use Panotools::Makefile::Rule; -use Panotools::Makefile::Variable; +use Panotools::Makefile; use Panotools::Photos; my $path_makefile; @@ -19,7 +18,7 @@ my $nostacks = 0; my @argv_save = @ARGV; -my @makefile; +my $makefile = new Panotools::Makefile; GetOptions ('o|output=s' => \$path_makefile, 't|time=s' => \$d_inc, @@ -34,52 +33,37 @@ pod2usage (2) unless scalar @ARGV > 1; $path_makefile = 'Makefile' unless defined $path_makefile; -my $rule_phony = new Panotools::Makefile::Rule; -$rule_phony->Targets ('.PHONY'); +my $rule_phony = $makefile->Rule ('.PHONY'); $rule_phony->Prerequisites (qw/all images pto mk qtvr hdr/); -my $rule_all = new Panotools::Makefile::Rule; -$rule_all->Targets ('all'); +my $rule_all = $makefile->Rule ('all'); $rule_all->Prerequisites ('images'); # some phony targets, prerequisites will be populated later -my $rule_ptos = new Panotools::Makefile::Rule; -$rule_ptos->Targets ('pto'); +my $rule_ptos = $makefile->Rule ('pto'); +my $rule_mks = $makefile->Rule ('mk'); +my $rule_imgs = $makefile->Rule ('images'); +my $rule_movs = $makefile->Rule ('qtvr'); +my $rule_hdrs = $makefile->Rule ('hdr'); -my $rule_mks = new Panotools::Makefile::Rule; -$rule_mks->Targets ('mk'); - -my $rule_imgs = new Panotools::Makefile::Rule; -$rule_imgs->Targets ('images'); - -my $rule_movs = new Panotools::Makefile::Rule; -$rule_movs->Targets ('qtvr'); - -my $rule_hdrs = new Panotools::Makefile::Rule; -$rule_hdrs->Targets ('hdr'); - -push @makefile, $rule_phony, $rule_all, $rule_ptos, $rule_mks, $rule_imgs, $rule_movs, $rule_hdrs; - # some variable definitions -my $make_extra_args = new Panotools::Makefile::Variable ('MAKE_EXTRA_ARGS', 'shell'); +my $make_extra_args = $makefile->Variable ('MAKE_EXTRA_ARGS', 'shell'); $make_extra_args->Values ('clean'); -my $hugindatadir = new Panotools::Makefile::Variable ('HUGINDATADIR', 'shell'); +my $hugindatadir = $makefile->Variable ('HUGINDATADIR', 'shell'); $hugindatadir->Values ('/usr/share/hugin'); -my $ap_extra_args = new Panotools::Makefile::Variable ('AP_EXTRA_ARGS', 'shell'); +my $ap_extra_args = $makefile->Variable ('AP_EXTRA_ARGS', 'shell'); $ap_extra_args->Values ('--clean'); -my $pto2mk = new Panotools::Makefile::Variable ('PTO2MK', 'shell'); +my $pto2mk = $makefile->Variable ('PTO2MK', 'shell'); $pto2mk->Values ('pto2mk'); -my $matchnshift = new Panotools::Makefile::Variable ('MATCHNSHIFT', 'shell'); +my $matchnshift = $makefile->Variable ('MATCHNSHIFT', 'shell'); $matchnshift->Values ('match-n-shift'); -push @makefile, $make_extra_args, $hugindatadir, $ap_extra_args, $pto2mk, $matchnshift; - # split the list of photos into likely panoramas my $all_photos = new Panotools::Photos (@ARGV); @@ -113,10 +97,12 @@ $rule_ptos->Prerequisites ("$stub.pto"); $rule_mks->Prerequisites ("$stub.pto.mk"); - my $rule_pto = new Panotools::Makefile::Rule; + my $rule_pto = $makefile->Rule; $rule_pto->Targets ("$stub.pto"); $rule_pto->Prerequisites ($photo_set->Paths); + $deg_fov = $photo_set->FOV unless defined $deg_fov; + my @command = ('$(MATCHNSHIFT)'); push @command, ('--stacks') unless $nostacks; push @command, ('--align', '$(AP_EXTRA_ARGS)', '--output', "$stub.pto"); @@ -125,69 +111,56 @@ push @command, ('--selection', $crop_s) if defined $crop_s; $rule_pto->Command (@command, $photo_set->Paths); - push @makefile, $rule_pto; - my $rule_mk = new Panotools::Makefile::Rule; + my $rule_mk = $makefile->Rule; $rule_mk->Targets ("$stub.pto.mk"); $rule_mk->Prerequisites ("$stub.pto"); $rule_mk->Command ('$(PTO2MK)', '-o', "$stub.pto.mk", '-p', $stub, "$stub.pto"); - push @makefile, $rule_mk; # rules for all possible output images - my $rule_ldr_blended = new Panotools::Makefile::Rule; + my $rule_ldr_blended = $makefile->Rule; $rule_ldr_blended->Targets ("$stub.tif"); $rule_ldr_blended->Prerequisites ("$stub.pto", "$stub.pto.mk", $photo_set->Paths); $rule_ldr_blended->Command ('$(MAKE)', '-e', '-f', "$stub.pto.mk", "$stub.tif", '$(MAKE_EXTRA_ARGS)'); - push @makefile, $rule_ldr_blended; - my $rule_ldr_stacked_blended = new Panotools::Makefile::Rule; + my $rule_ldr_stacked_blended = $makefile->Rule; $rule_ldr_stacked_blended->Targets ("$stub_fused.tif"); $rule_ldr_stacked_blended->Prerequisites ("$stub.pto", "$stub.pto.mk", $photo_set->Paths); $rule_ldr_stacked_blended->Command ('$(MAKE)', '-e', '-f', "$stub.pto.mk", "$stub_fused.tif", '$(MAKE_EXTRA_ARGS)'); - push @makefile, $rule_ldr_stacked_blended; - my $rule_ldr_exposure_layers_fused = new Panotools::Makefile::Rule; + my $rule_ldr_exposure_layers_fused = $makefile->Rule; $rule_ldr_exposure_layers_fused->Targets ("$stub_blended_fused.tif"); $rule_ldr_exposure_layers_fused->Prerequisites ("$stub.pto", "$stub.pto.mk", $photo_set->Paths); $rule_ldr_exposure_layers_fused->Command ('$(MAKE)', '-e', '-f', "$stub.pto.mk", "$stub_blended_fused.tif", '$(MAKE_EXTRA_ARGS)'); - push @makefile, $rule_ldr_exposure_layers_fused; - my $rule_hdr_blended = new Panotools::Makefile::Rule; + my $rule_hdr_blended = $makefile->Rule; $rule_hdr_blended->Targets ($stub ."_hdr.exr"); $rule_hdr_blended->Prerequisites ("$stub.pto", "$stub.pto.mk", $photo_set->Paths); $rule_hdr_blended->Command ('$(MAKE)', '-e', '-f', "$stub.pto.mk", $stub ."_hdr.exr", '$(MAKE_EXTRA_ARGS)'); - push @makefile, $rule_hdr_blended; # rules for secondary output (QTVR, little planets etc...) - my $rule_ldr_blended_equirect = new Panotools::Makefile::Rule; + my $rule_ldr_blended_equirect = $makefile->Rule; $rule_ldr_blended_equirect->Targets ("$stub.mov", "$stub-sky.jpg", "$stub-planet.jpg", "$stub-mercator.jpg"); $rule_ldr_blended_equirect->Prerequisites ("$stub.pto", "$stub.pto.mk", "$stub.tif"); $rule_ldr_blended_equirect->Command ('$(MAKE)', '-e', '-f', '$(HUGINDATADIR)/Makefile.equirect.mk', 'equirect_all', 'equirect_clean', "PTO=$stub.pto", 'FUSED_SUFFIX='); - push @makefile, $rule_ldr_blended_equirect; - my $rule_ldr_stacked_blended_equirect = new Panotools::Makefile::Rule; + my $rule_ldr_stacked_blended_equirect = $makefile->Rule; $rule_ldr_stacked_blended_equirect->Targets ("$stub_fused.mov", "$stub_fused-sky.jpg", "$stub_fused-planet.jpg", "$stub_fused-mercator.jpg"); $rule_ldr_stacked_blended_equirect->Prerequisites ("$stub.pto", "$stub.pto.mk", "$stub_fused.tif"); $rule_ldr_stacked_blended_equirect->Command ('$(MAKE)', '-e', '-f', '$(HUGINDATADIR)/Makefile.equirect.mk', 'equirect_all', 'equirect_clean', "PTO=$stub.pto", 'FUSED_SUFFIX=_fused'); - push @makefile, $rule_ldr_stacked_blended_equirect; } -my $rule_self = new Panotools::Makefile::Rule; +my $rule_self = $makefile->Rule; $rule_self->Targets ($path_makefile); $rule_self->Prerequisites (@ARGV); $rule_self->Command ($0, @argv_save); -push @makefile, $rule_self; +$makefile->Write ($path_makefile); -open MAKE, ">", $path_makefile or die "cannot write-open $path_makefile"; -print MAKE "# Created by Panotools::Script $Panotools::Script::VERSION\n"; -print MAKE map {$_->Assemble} @makefile; -close MAKE; - __END__ =head1 NAME @@ -196,7 +169,7 @@ =head1 SYNOPSIS -panostart [options] --output Makefile image1 image2 [...] +panostart [options] image1 image2 [...] Options: -o | --output name Filename of created Makefile @@ -204,9 +177,10 @@ -f | --projection Panotools style input projection number. Use 0 for rectilinear, 2 for circular fisheye and 3 for full-frame fisheye images. - -v | --fov Horizontal field of view in degrees + -v | --fov Horizontal field of view in degrees. Otherwise will + be calculated from EXIF info. -k | --selection Crop selection boundary, eg -459,2459,-57,2861 - -n | --nostacks Don't try and align stacks for point and shoot cameras + -n | --nostacks Don't try and align stacks (use for cameras on auto-exposure) -h | --help Outputs help documentation. -l | --loquacious Verbose output listing targets and numbers of images. Modified: trunk/Panotools-Script/lib/Panotools/Makefile/Rule.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Makefile/Rule.pm 2009-11-05 23:34:56 UTC (rev 1129) +++ trunk/Panotools-Script/lib/Panotools/Makefile/Rule.pm 2009-11-05 23:43:21 UTC (rev 1130) @@ -19,19 +19,23 @@ use strict; use warnings; -use Panotools::Makefile qw/quotetarget quoteprerequisite quoteshell/; +use Panotools::Makefile::Utils qw/quotetarget quoteprerequisite quoteshell/; =head1 USAGE my $rule = new Panotools::Makefile::Rule; +..or additionally specify targets at creation time + + my $rule = new Panotools::Makefile::Rule ('all'); + =cut sub new { my $class = shift; $class = ref $class || $class; - my $self = bless {targets => [], prerequisites => [], command => []}, $class; + my $self = bless {targets => [@_], prerequisites => [], command => []}, $class; return $self; } Added: trunk/Panotools-Script/lib/Panotools/Makefile/Utils.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Makefile/Utils.pm (rev 0) +++ trunk/Panotools-Script/lib/Panotools/Makefile/Utils.pm 2009-11-05 23:43:21 UTC (rev 1130) @@ -0,0 +1,151 @@ +package Panotools::Makefile::Utils; + +=head1 NAME + +Panotools::Makefile::Utils - Makefile syntax + +=head1 SYNOPSIS + +Simple interface for generating Makefile syntax + +=head1 DESCRIPTION + +Writing Makefiles directly from perl scripts with print and "\t" etc... is +prone to error, this library provides a simple perl interface for assembling +Makefile rules. + +See L<Panotools::Makefile::Rule> and L<Panotools::Makefile::Variable> for +object classes that you can use to contruct makefiles. + +=cut + +use strict; +use warnings; + +use Exporter; +use vars qw /@ISA @EXPORT_OK/; +@ISA = qw /Exporter/; +@EXPORT_OK = qw /platform quotetarget quoteprerequisite quoteshell/; + +our $PLATFORM; + +=head1 USAGE + +Access the current platform name (MSWin32, linux, etc...): + + print platform; + +Define a different platform and access the new name: + + platform ('MSWin32'); + print platform; + +Reset platform to default: + + platform (undef); + +=cut + +sub platform +{ + $PLATFORM = shift if @_; + return $PLATFORM if defined $PLATFORM; + return $^O; +} + +=pod + +Take a text string (typically a single filename or path) and quote/escape +spaces and special characters to make it suitable for use as a Makefile +'target' or 'prerequisite': + + $escaped_target = quotetarget ('My Filename.txt'); + $escaped_prerequisite = quoteprerequisite ('My Filename.txt'); + +Note that the =;:% characters are not usable as filenames, they may be used as +control characters in a target or prerequisite. An exception is the : in +Windows paths such as C:\WINDOWS which is understood by gnu make. + +* and ? are wildcards and will be expanded. You may find that it is +possible to use these as actual characters in filenames, but this assumption +will lead to subtle errors. + +$ can be used in a filename, but when used with brackets, ${FOO} or $(BAR), +will be substituted as a make variable. + +Targets starting with . are special make targets and not usable as filenames, +the workaround is to supply a full path instead of a relative path. i.e: +/foo/bar/.hugin rather than .hugin + +Additionally the ?<>*|"^\ characters are not portable across filesystems (e.g. +USB sticks, CDs, Windows) and should be avoided in filenames. + +=cut + +sub quotetarget +{ + my $string = shift; + # Transform all C:\foo\bar paths to C:/foo/bar + $string =~ s/\\/\//g if (platform =~ /^(MSWin|dos)/); + $string =~ s/([ #|\\])/\\$1/g; + # escape $ as $$ unless part of a $(VARIABLE) + $string =~ s/\$([^({]|$)/\$\$$1/g; + return $string; +} + +sub quoteprerequisite +{ + my $string = shift; + # Transform all C:\foo\bar paths to C:/foo/bar + $string =~ s/\\/\//g if (platform =~ /^(MSWin|dos)/); + $string =~ s/([ #|\\])/\\$1/g; + # escape $ as $$ unless part of a $(VARIABLE) + $string =~ s/\$([^({]|$)/\$\$$1/g; + return $string; +} + +=pod + +Take a text string, typically a command-line token, and quote/escape spaces and +special characters to make it suitable for use in a Makefile command: + + $escaped_token = quoteshell ('Hello World'); + +=cut + +sub quoteshell +{ + my $string = shift; + if (platform =~ /^(MSWin|dos)/) + { + # ?<>:*|"^ are unusable in Windows filenames, + # other unix shell characters are unspecial in Windows + # so the only thing we can quote is a space + $string = '"'.$string.'"' if $string =~ / /; + # Transform all C:\foo\bar paths to C:/foo/bar + # Not all tokens are file paths, so \:-) will become /:-) + $string =~ s/\\/\//g; + # hash is parsed by make as a comment, backslash escape + $string =~ s/#/\\#/g; + # escape $ as $$ unless part of a $(VARIABLE) + $string =~ s/\$([^({]|$)/\$\$$1/g; + } + else + { + # some shell char sequences are useful shell commands + # others are automatic variables $(<D) $(<F) $< + unless ($string =~ /^([&<>|]|2>|\|\||&&|2>&1|`[^`]+`)$/ + or $string =~ /^(\$\(<D\)|\$\(<F\)|\$<|\$@|\$%|\$\?|\$\^|\$\+|\$\||\$\*)$/) + { + # backslash escape shell characters + $string =~ s/([!#'"() `&<>|\\])/\\$1/g; + # unquote $(FOO) variables escaped above + $string =~ s/\$\\\(([^)]+)\\\)/\$($1)/g; + # double escape $ as \$$ unless part of a $(VARIABLE) + $string =~ s/\$([^({]|$)/\\\$\$$1/g; + } + } + return $string; +} + +1; Modified: trunk/Panotools-Script/lib/Panotools/Makefile/Variable.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Makefile/Variable.pm 2009-11-05 23:34:56 UTC (rev 1129) +++ trunk/Panotools-Script/lib/Panotools/Makefile/Variable.pm 2009-11-05 23:43:21 UTC (rev 1130) @@ -19,7 +19,7 @@ use strict; use warnings; -use Panotools::Makefile qw/quotetarget quoteprerequisite quoteshell/; +use Panotools::Makefile::Utils qw/quotetarget quoteprerequisite quoteshell/; =head1 USAGE @@ -77,7 +77,7 @@ $var->Quoting ('target'); -(See L<Panotools::Makefile> for description of quoting styles) +(See L<Panotools::Makefile::Utils> for description of quoting styles) The variable name should not require escaping and should consist of safe letters, numbers and the underscore: A-Z a-z 0-9 _ Modified: trunk/Panotools-Script/lib/Panotools/Makefile.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Makefile.pm 2009-11-05 23:34:56 UTC (rev 1129) +++ trunk/Panotools-Script/lib/Panotools/Makefile.pm 2009-11-05 23:43:21 UTC (rev 1130) @@ -6,148 +6,123 @@ =head1 SYNOPSIS -Simple interface for generating Makefile syntax +Simple object interface for generating Makefiles =head1 DESCRIPTION Writing Makefiles directly from perl scripts with print and "\t" etc... is prone to error, this library provides a simple perl interface for assembling -Makefile rules. +Makefiles. -See L<Panotools::Makefile::Rule> and L<Panotools::Makefile::Variable> for -object classes that you can use to contruct makefiles. - =cut use strict; use warnings; -use Exporter; -use vars qw /@ISA @EXPORT_OK/; -@ISA = qw /Exporter/; -@EXPORT_OK = qw /platform quotetarget quoteprerequisite quoteshell/; +use Panotools::Script; +use Panotools::Makefile::Rule; +use Panotools::Makefile::Variable; +use File::Temp qw/tempdir/; +use File::Spec; -our $PLATFORM; - =head1 USAGE - use Panotools::Makefile qw/platform quotetarget quoteprerequisite quoteshell/; + use Panotools::Makefile; -Access the current platform name (MSWin32, linux, etc...): +Create a new Makefile object: - print platform; + my $makefile = new Panotools::Makefile; -Define a different platform and access the new name: - - platform ('MSWin32'); - print platform; - -Reset platform to default: - - platform (undef); - =cut -sub platform +sub new { - $PLATFORM = shift if @_; - return $PLATFORM if defined $PLATFORM; - return $^O; + my $class = shift; + $class = ref $class || $class; + my $self = bless {items => []}, $class; + return $self; } =pod -Take a text string (typically a single filename or path) and quote/escape -spaces and special characters to make it suitable for use as a Makefile -'target' or 'prerequisite': +Start adding items to the Makefile: - $escaped_target = quotetarget ('My Filename.txt'); - $escaped_prerequisite = quoteprerequisite ('My Filename.txt'); +Rule() returns a new L<Panotools::Makefile::Rule> object and Variable() returns +a new L<Panotools::Makefile::Variable> object: -Note that the =;:% characters are not usable as filenames, they may be used as -control characters in a target or prerequisite. An exception is the : in -Windows paths such as C:\WINDOWS which is understood by gnu make. + my $var_user = $makefile->Variable ('USER', 'shell'); + $var_user->Values ("Dr. Largio d'Apalansius (MB)"); -* and ? are wildcards and will be expanded. You may find that it is -possible to use these as actual characters in filenames, but this assumption -will lead to subtle errors. + my $rule_all = $makefile->Rule ('all'); + $rule_all->Command ('echo', '$(USER)', '>', 'My File.txt'); -$ can be used in a filename, but when used with brackets, ${FOO} or $(BAR), -will be substituted as a make variable. + my $rule_phony = $makefile->Rule; + $rule_phony->Targets ('.PHONY'); + $rule_phony->Prerequisites ('all'); -Targets starting with . are special make targets and not usable as filenames, -the workaround is to supply a full path instead of a relative path. i.e: -/foo/bar/.hugin rather than .hugin - -Additionally the ?<>*|"^\ characters are not portable across filesystems (e.g. -USB sticks, CDs, Windows) and should be avoided in filenames. - =cut -sub quotetarget +sub Rule { - my $string = shift; - # Transform all C:\foo\bar paths to C:/foo/bar - $string =~ s/\\/\//g if (platform =~ /^(MSWin|dos)/); - $string =~ s/([ #|\\])/\\$1/g; - # escape $ as $$ unless part of a $(VARIABLE) - $string =~ s/\$([^({]|$)/\$\$$1/g; - return $string; + my $self = shift; + my $rule = new Panotools::Makefile::Rule (@_); + push @{$self->{items}}, $rule; + return $rule; } -sub quoteprerequisite +sub Variable { - my $string = shift; - # Transform all C:\foo\bar paths to C:/foo/bar - $string =~ s/\\/\//g if (platform =~ /^(MSWin|dos)/); - $string =~ s/([ #|\\])/\\$1/g; - # escape $ as $$ unless part of a $(VARIABLE) - $string =~ s/\$([^({]|$)/\$\$$1/g; - return $string; + my $self = shift; + my $variable = new Panotools::Makefile::Variable (@_); + push @{$self->{items}}, $variable; + return $variable; } =pod -Take a text string, typically a command-line token, and quote/escape spaces and -special characters to make it suitable for use in a Makefile command: +Write the Makefile: - $escaped_token = quoteshell ('Hello World'); + $makefile->Write ('/path/to/Makefile'); =cut -sub quoteshell +sub Write { - my $string = shift; - if (platform =~ /^(MSWin|dos)/) - { - # ?<>:*|"^ are unusable in Windows filenames, - # other unix shell characters are unspecial in Windows - # so the only thing we can quote is a space - $string = '"'.$string.'"' if $string =~ / /; - # Transform all C:\foo\bar paths to C:/foo/bar - # Not all tokens are file paths, so \:-) will become /:-) - $string =~ s/\\/\//g; - # hash is parsed by make as a comment, backslash escape - $string =~ s/#/\\#/g; - # escape $ as $$ unless part of a $(VARIABLE) - $string =~ s/\$([^({]|$)/\$\$$1/g; - } - else - { - # some shell char sequences are useful shell commands - # others are automatic variables $(<D) $(<F) $< - unless ($string =~ /^([&<>|]|2>|\|\||&&|2>&1|`[^`]+`)$/ - or $string =~ /^(\$\(<D\)|\$\(<F\)|\$<|\$@|\$%|\$\?|\$\^|\$\+|\$\||\$\*)$/) - { - # backslash escape shell characters - $string =~ s/([!#'"() `&<>|\\])/\\$1/g; - # unquote $(FOO) variables escaped above - $string =~ s/\$\\\(([^)]+)\\\)/\$($1)/g; - # double escape $ as \$$ unless part of a $(VARIABLE) - $string =~ s/\$([^({]|$)/\\\$\$$1/g; - } - } - return $string; + my $self = shift; + my $path_makefile = shift; + open MAKE, ">", $path_makefile or warn "cannot write-open $path_makefile"; + print MAKE "# Created by Panotools::Script $Panotools::Script::VERSION\n\n"; + print MAKE map {$_->Assemble} @{$self->{items}}; + close MAKE; } +=pod + +..or let the module execute rules with 'make' directly: + + $makefile->DoIt ('all') || warn "Didn't work :-("; + +The following command will be executed, something that isn't possible with perl +system() or exec(), and would otherwise require careful assembly with backticks: + + echo Dr.\ Largio\ d\'Apalansius\ \(MB\) > My\ File.txt + +On the Windows platform you get appropriate quoting: + + echo "Dr. Largio d'Apalansius (MB)" > "My File.txt" + +=cut + +sub DoIt +{ + my $self = shift; + my $tempdir = tempdir (CLEANUP => 1); + my $path_makefile = File::Spec->catfile ($tempdir, 'Makefile'); + $self->Write ($path_makefile); + system ('make', '-f', $path_makefile, @_); + return 1 if ($? == 0); + return 0; +} + 1; + Modified: trunk/Panotools-Script/t/102.platform.t =================================================================== --- trunk/Panotools-Script/t/102.platform.t 2009-11-05 23:34:56 UTC (rev 1129) +++ trunk/Panotools-Script/t/102.platform.t 2009-11-05 23:43:21 UTC (rev 1130) @@ -6,10 +6,10 @@ use Test::More 'no_plan'; use lib 'lib'; -use Panotools::Makefile qw/platform/; +use Panotools::Makefile::Utils qw/platform/; ok (1); -ok (Panotools::Makefile::platform eq $^O); +ok (Panotools::Makefile::Utils::platform eq $^O); ok (platform eq $^O); ok (platform ('FOO')); @@ -27,4 +27,4 @@ ok (platform (undef)); ok (platform eq $^O); -ok (Panotools::Makefile::platform eq $^O); +ok (Panotools::Makefile::Utils::platform eq $^O); Modified: trunk/Panotools-Script/t/103.platform.t =================================================================== --- trunk/Panotools-Script/t/103.platform.t 2009-11-05 23:34:56 UTC (rev 1129) +++ trunk/Panotools-Script/t/103.platform.t 2009-11-05 23:43:21 UTC (rev 1130) @@ -7,7 +7,7 @@ use lib 'lib'; use Panotools::Makefile::Rule; -use Panotools::Makefile qw/platform/; +use Panotools::Makefile::Utils qw/platform/; ok (1); my $rule = new Panotools::Makefile::Rule; Modified: trunk/Panotools-Script/t/104.metachars.t =================================================================== --- trunk/Panotools-Script/t/104.metachars.t 2009-11-05 23:34:56 UTC (rev 1129) +++ trunk/Panotools-Script/t/104.metachars.t 2009-11-05 23:43:21 UTC (rev 1130) @@ -7,7 +7,7 @@ use lib 'lib'; use Panotools::Makefile::Rule; -use Panotools::Makefile qw/platform/; +use Panotools::Makefile::Utils qw/platform/; ok (1); my $rule = new Panotools::Makefile::Rule; Modified: trunk/Panotools-Script/t/105.vars.t =================================================================== --- trunk/Panotools-Script/t/105.vars.t 2009-11-05 23:34:56 UTC (rev 1129) +++ trunk/Panotools-Script/t/105.vars.t 2009-11-05 23:43:21 UTC (rev 1130) @@ -7,7 +7,7 @@ use lib 'lib'; use Panotools::Makefile::Variable; -use Panotools::Makefile qw/platform/; +use Panotools::Makefile::Utils qw/platform/; ok (1); my $var = new Panotools::Makefile::Variable; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bru...@us...> - 2009-11-06 23:52:00
|
Revision: 1131 http://panotools.svn.sourceforge.net/panotools/?rev=1131&view=rev Author: brunopostle Date: 2009-11-06 23:51:33 +0000 (Fri, 06 Nov 2009) Log Message: ----------- fix detection of longest exposure in bracketed sets Modified Paths: -------------- trunk/Panotools-Script/Changes trunk/Panotools-Script/bin/match-n-shift Modified: trunk/Panotools-Script/Changes =================================================================== --- trunk/Panotools-Script/Changes 2009-11-05 23:43:21 UTC (rev 1130) +++ trunk/Panotools-Script/Changes 2009-11-06 23:51:33 UTC (rev 1131) @@ -8,6 +8,7 @@ - panostart will get FoV from EXIF data - Split utilities for querying list of photos to Panotools::Photos - erect2cubic --face option to optionally specify cubeface pixel size + - match-n-shift fix detection of longest exposure in bracketed sets 0.23 - Add new projections to pod documentation and ptoinfo output Modified: trunk/Panotools-Script/bin/match-n-shift =================================================================== --- trunk/Panotools-Script/bin/match-n-shift 2009-11-05 23:43:21 UTC (rev 1130) +++ trunk/Panotools-Script/bin/match-n-shift 2009-11-06 23:51:33 UTC (rev 1131) @@ -107,7 +107,11 @@ $longest = $et unless defined $longest; $sec_longest = $sec_et unless defined $sec_longest; - $longest = $et if $sec_et > $sec_longest; + if ($sec_et > $sec_longest) + { + $longest = $et; + $sec_longest = $sec_et; + } } print STDERR "Longest exposure: $longest\n"; This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bru...@us...> - 2009-11-08 23:27:01
|
Revision: 1139 http://panotools.svn.sourceforge.net/panotools/?rev=1139&view=rev Author: brunopostle Date: 2009-11-08 23:26:49 +0000 (Sun, 08 Nov 2009) Log Message: ----------- Only retrieve EXIF info from photos once Modified Paths: -------------- trunk/Panotools-Script/lib/Panotools/Photos.pm trunk/Panotools-Script/t/106.photos.t Modified: trunk/Panotools-Script/lib/Panotools/Photos.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Photos.pm 2009-11-08 17:20:34 UTC (rev 1138) +++ trunk/Panotools-Script/lib/Panotools/Photos.pm 2009-11-08 23:26:49 UTC (rev 1139) @@ -38,7 +38,8 @@ { my $class = shift; $class = ref $class || $class; - my $self = bless {images => [@_]}, $class; + my $self = bless [], $class; + $self->Paths (@_); return $self; } @@ -54,8 +55,11 @@ sub Paths { my $self = shift; - push @{$self->{images}}, @_; - return @{$self->{images}}; + for my $path (@_) + { + push @{$self}, {path => $path, exif => Image::ExifTool::ImageInfo ($path)}; + } + return map ($_->{path}, @{$self}); } =pod @@ -72,8 +76,8 @@ sub Stub { my $self = shift; - my $path_a = $self->{images}->[0]; - my $path_b = $self->{images}->[-1]; + my $path_a = $self->[0]->{path}; + my $path_b = $self->[-1]->{path}; # strip any suffixes $path_a =~ s/\.[[:alnum:]]+$//; $path_b =~ s/\.[[:alnum:]]+$//; @@ -98,15 +102,14 @@ { my $self = shift; my $speeds = {}; - for my $path_photo ($self->Paths) + for my $image (@{$self}) { - my $exif_info = Image::ExifTool::ImageInfo ($path_photo, 'ExposureTime', 'ShutterSpeed'); - my $et = $exif_info->{ExposureTime} || $exif_info->{ShutterSpeed} || 0; + my $et = $image->{exif}->{ExposureTime} || $image->{exif}->{ShutterSpeed} || 0; $speeds->{$et} = 'TRUE'; } my $brackets = scalar keys (%{$speeds}); - return 0 if (scalar ($self->Paths) % $brackets); + return 0 if (scalar (@{$self}) % $brackets); return 0 if ($brackets < 2); return 1; } @@ -125,17 +128,15 @@ sub SplitInterval { my $self = shift; - my $d_inc = shift; + my $d_inc = shift || 15; my @groups; my $group_tmp = new Panotools::Photos; my $previous_time; my $previous_inc = 0; - for my $path_photo ($self->Paths) + for my $image (@{$self}) { - my $exif_info = Image::ExifTool::ImageInfo ($path_photo); - my $datetime = $exif_info->{'FileModificationDateTime'}; - $datetime = $exif_info->{'DateTimeOriginal'} if (defined $exif_info->{'DateTimeOriginal'}); + 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; @@ -145,7 +146,7 @@ push @groups, $group_tmp; $group_tmp = new Panotools::Photos; } - $group_tmp->Paths ($path_photo); + push @{$group_tmp}, $image; $previous_time = $time_unix; $previous_inc = $inc; @@ -173,9 +174,7 @@ my $self = shift; my $index = 0; $index = shift if @_; - my $path_photo = $self->{images}->[$index]; - my $exif_info = Image::ExifTool::ImageInfo ($path_photo); - my $fov = $exif_info->{'FOV'}; + my $fov = $self->[$index]->{exif}->{'FOV'}; $fov =~ s/[^0-9.]*$// if defined $fov; return $fov; } Modified: trunk/Panotools-Script/t/106.photos.t =================================================================== --- trunk/Panotools-Script/t/106.photos.t 2009-11-08 17:20:34 UTC (rev 1138) +++ trunk/Panotools-Script/t/106.photos.t 2009-11-08 23:26:49 UTC (rev 1139) @@ -23,7 +23,14 @@ ok ($photos->FOV (0) == 54.4); ok ($photos->FOV (-1) == 54.4); +ok (scalar $photos->SplitInterval (10) == 3); +ok (scalar $photos->SplitInterval (15) == 2); +ok (scalar $photos->SplitInterval (20) == 2); +ok (scalar $photos->SplitInterval (25) == 2); +ok (scalar $photos->SplitInterval (30) == 1); + # this one deosn't have any EXIF info $photos = new Panotools::Photos ('t/data/equirectangular/equirectangular.jpg'); ok (defined $photos->FOV == 0); +ok (scalar $photos->SplitInterval (15) == 1); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bru...@us...> - 2009-11-11 18:40:36
|
Revision: 1147 http://panotools.svn.sourceforge.net/panotools/?rev=1147&view=rev Author: brunopostle Date: 2009-11-11 18:40:26 +0000 (Wed, 11 Nov 2009) Log Message: ----------- Stop specifying different quoting for different variables, just write out the variable twice, once for each quoting style. Add class for Makefile comments. Modified Paths: -------------- trunk/Panotools-Script/MANIFEST trunk/Panotools-Script/bin/panostart trunk/Panotools-Script/lib/Panotools/Makefile/Rule.pm trunk/Panotools-Script/lib/Panotools/Makefile/Variable.pm trunk/Panotools-Script/lib/Panotools/Makefile.pm Added Paths: ----------- trunk/Panotools-Script/lib/Panotools/Makefile/Comment.pm Modified: trunk/Panotools-Script/MANIFEST =================================================================== --- trunk/Panotools-Script/MANIFEST 2009-11-10 22:45:39 UTC (rev 1146) +++ trunk/Panotools-Script/MANIFEST 2009-11-11 18:40:26 UTC (rev 1147) @@ -46,6 +46,7 @@ doc/match-n-shift.svg dos/make_exe.pl lib/Panotools/Makefile.pm +lib/Panotools/Makefile/Comment.pm lib/Panotools/Makefile/Rule.pm lib/Panotools/Makefile/Variable.pm lib/Panotools/Makefile/Utils.pm Modified: trunk/Panotools-Script/bin/panostart =================================================================== --- trunk/Panotools-Script/bin/panostart 2009-11-10 22:45:39 UTC (rev 1146) +++ trunk/Panotools-Script/bin/panostart 2009-11-11 18:40:26 UTC (rev 1147) @@ -49,19 +49,19 @@ # some variable definitions -my $make_extra_args = $makefile->Variable ('MAKE_EXTRA_ARGS', 'shell'); +my $make_extra_args = $makefile->Variable ('MAKE_EXTRA_ARGS'); $make_extra_args->Values ('clean'); -my $hugindatadir = $makefile->Variable ('HUGINDATADIR', 'shell'); +my $hugindatadir = $makefile->Variable ('HUGINDATADIR'); $hugindatadir->Values ('/usr/share/hugin'); -my $ap_extra_args = $makefile->Variable ('AP_EXTRA_ARGS', 'shell'); +my $ap_extra_args = $makefile->Variable ('AP_EXTRA_ARGS'); $ap_extra_args->Values ('--clean'); -my $pto2mk = $makefile->Variable ('PTO2MK', 'shell'); +my $pto2mk = $makefile->Variable ('PTO2MK'); $pto2mk->Values ('pto2mk'); -my $matchnshift = $makefile->Variable ('MATCHNSHIFT', 'shell'); +my $matchnshift = $makefile->Variable ('MATCHNSHIFT'); $matchnshift->Values ('match-n-shift'); # split the list of photos into likely panoramas @@ -103,9 +103,9 @@ $deg_fov = $photo_set->FOV unless defined $deg_fov; - my @command = ('$(MATCHNSHIFT)'); + my @command = ('$(MATCHNSHIFT_SHELL)'); push @command, ('--stacks') unless $nostacks; - push @command, ('--align', '$(AP_EXTRA_ARGS)', '--output', "$stub.pto"); + push @command, ('--align', '$(AP_EXTRA_ARGS_SHELL)', '--output', "$stub.pto"); push @command, ('--projection', $projection) if defined $projection; push @command, ('--fov', $deg_fov) if defined $deg_fov; push @command, ('--selection', $crop_s) if defined $crop_s; @@ -115,42 +115,42 @@ my $rule_mk = $makefile->Rule; $rule_mk->Targets ("$stub.pto.mk"); $rule_mk->Prerequisites ("$stub.pto"); - $rule_mk->Command ('$(PTO2MK)', '-o', "$stub.pto.mk", '-p', $stub, "$stub.pto"); + $rule_mk->Command ('$(PTO2MK_SHELL)', '-o', "$stub.pto.mk", '-p', $stub, "$stub.pto"); # rules for all possible output images my $rule_ldr_blended = $makefile->Rule; $rule_ldr_blended->Targets ("$stub.tif"); $rule_ldr_blended->Prerequisites ("$stub.pto", "$stub.pto.mk", $photo_set->Paths); - $rule_ldr_blended->Command ('$(MAKE)', '-e', '-f', "$stub.pto.mk", "$stub.tif", '$(MAKE_EXTRA_ARGS)'); + $rule_ldr_blended->Command ('$(MAKE)', '-e', '-f', "$stub.pto.mk", "$stub.tif", '$(MAKE_EXTRA_ARGS_SHELL)'); my $rule_ldr_stacked_blended = $makefile->Rule; $rule_ldr_stacked_blended->Targets ("$stub_fused.tif"); $rule_ldr_stacked_blended->Prerequisites ("$stub.pto", "$stub.pto.mk", $photo_set->Paths); - $rule_ldr_stacked_blended->Command ('$(MAKE)', '-e', '-f', "$stub.pto.mk", "$stub_fused.tif", '$(MAKE_EXTRA_ARGS)'); + $rule_ldr_stacked_blended->Command ('$(MAKE)', '-e', '-f', "$stub.pto.mk", "$stub_fused.tif", '$(MAKE_EXTRA_ARGS_SHELL)'); my $rule_ldr_exposure_layers_fused = $makefile->Rule; $rule_ldr_exposure_layers_fused->Targets ("$stub_blended_fused.tif"); $rule_ldr_exposure_layers_fused->Prerequisites ("$stub.pto", "$stub.pto.mk", $photo_set->Paths); - $rule_ldr_exposure_layers_fused->Command ('$(MAKE)', '-e', '-f', "$stub.pto.mk", "$stub_blended_fused.tif", '$(MAKE_EXTRA_ARGS)'); + $rule_ldr_exposure_layers_fused->Command ('$(MAKE)', '-e', '-f', "$stub.pto.mk", "$stub_blended_fused.tif", '$(MAKE_EXTRA_ARGS_SHELL)'); my $rule_hdr_blended = $makefile->Rule; $rule_hdr_blended->Targets ($stub ."_hdr.exr"); $rule_hdr_blended->Prerequisites ("$stub.pto", "$stub.pto.mk", $photo_set->Paths); - $rule_hdr_blended->Command ('$(MAKE)', '-e', '-f', "$stub.pto.mk", $stub ."_hdr.exr", '$(MAKE_EXTRA_ARGS)'); + $rule_hdr_blended->Command ('$(MAKE)', '-e', '-f', "$stub.pto.mk", $stub ."_hdr.exr", '$(MAKE_EXTRA_ARGS_SHELL)'); # rules for secondary output (QTVR, little planets etc...) my $rule_ldr_blended_equirect = $makefile->Rule; $rule_ldr_blended_equirect->Targets ("$stub.mov", "$stub-sky.jpg", "$stub-planet.jpg", "$stub-mercator.jpg"); $rule_ldr_blended_equirect->Prerequisites ("$stub.pto", "$stub.pto.mk", "$stub.tif"); - $rule_ldr_blended_equirect->Command ('$(MAKE)', '-e', '-f', '$(HUGINDATADIR)/Makefile.equirect.mk', + $rule_ldr_blended_equirect->Command ('$(MAKE)', '-e', '-f', '$(HUGINDATADIR_SHELL)/Makefile.equirect.mk', 'equirect_all', 'equirect_clean', "PTO=$stub.pto", 'FUSED_SUFFIX='); my $rule_ldr_stacked_blended_equirect = $makefile->Rule; $rule_ldr_stacked_blended_equirect->Targets ("$stub_fused.mov", "$stub_fused-sky.jpg", "$stub_fused-planet.jpg", "$stub_fused-mercator.jpg"); $rule_ldr_stacked_blended_equirect->Prerequisites ("$stub.pto", "$stub.pto.mk", "$stub_fused.tif"); - $rule_ldr_stacked_blended_equirect->Command ('$(MAKE)', '-e', '-f', '$(HUGINDATADIR)/Makefile.equirect.mk', + $rule_ldr_stacked_blended_equirect->Command ('$(MAKE)', '-e', '-f', '$(HUGINDATADIR_SHELL)/Makefile.equirect.mk', 'equirect_all', 'equirect_clean', "PTO=$stub.pto", 'FUSED_SUFFIX=_fused'); } Added: trunk/Panotools-Script/lib/Panotools/Makefile/Comment.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Makefile/Comment.pm (rev 0) +++ trunk/Panotools-Script/lib/Panotools/Makefile/Comment.pm 2009-11-11 18:40:26 UTC (rev 1147) @@ -0,0 +1,72 @@ +package Panotools::Makefile::Comment; + +=head1 NAME + +Panotools::Makefile::Comment - Assemble Makefile Comment lines + +=head1 SYNOPSIS + +Simple interface for generating Makefile syntax + +=head1 DESCRIPTION + +Writing Makefiles directly from perl scripts with print and "\t" etc... is +prone to error, this library provides a simple perl interface for assembling +Makefiles. + +=cut + +use strict; +use warnings; + +=head1 USAGE + + my $note = new Panotools::Makefile::Comment; + +..or add text at the same time: + + my $note = new Panotools::Makefile::Comment ('Warning, may not eat your cat!'); + +=cut + +sub new +{ + my $class = shift; + $class = ref $class || $class; + my $self = bless [@_], $class; + return $self; +} + +=pod + +Add lines to the comment: + + $note->Lines ('..but it might...', '...sometimes'); + +=cut + +sub Name +{ + my $self = shift; + push @{$self}, @_; +} + +=pod + +Construct a text fragment suitable for use in a Makefile like so: + + $text = $note->Assemble; + +=cut + +sub Assemble +{ + my $self = shift; + return '' unless scalar @{$self}; + + my $text = "\n# "; + $text .= join "\n# ", @{$self}; + return $text . "\n"; +} + +1; Modified: trunk/Panotools-Script/lib/Panotools/Makefile/Rule.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Makefile/Rule.pm 2009-11-10 22:45:39 UTC (rev 1146) +++ trunk/Panotools-Script/lib/Panotools/Makefile/Rule.pm 2009-11-11 18:40:26 UTC (rev 1147) @@ -111,7 +111,7 @@ sub Assemble { my $self = shift; - return 0 unless scalar @{$self->{targets}}; + return '' unless scalar @{$self->{targets}}; my $text; $text .= join ' ', (map { quotetarget ($_)} @{$self->{targets}}); Modified: trunk/Panotools-Script/lib/Panotools/Makefile/Variable.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Makefile/Variable.pm 2009-11-10 22:45:39 UTC (rev 1146) +++ trunk/Panotools-Script/lib/Panotools/Makefile/Variable.pm 2009-11-11 18:40:26 UTC (rev 1147) @@ -23,19 +23,23 @@ =head1 USAGE - my $var = new Panotools::Makefile::Variable; + $var = new Panotools::Makefile::Variable; -..or define the 'variable name' and quoting style at the same time: +..or define the 'variable name' at the same time: - my $var = new Panotools::Makefile::Variable ('USERS', 'shell'); + $var = new Panotools::Makefile::Variable ('USERS'); +..or define the name and values at the same time: + + $var = new Panotools::Makefile::Variable ('USERS', 'Andy Pandy'); + =cut sub new { my $class = shift; $class = ref $class || $class; - my $self = bless {name => shift, value => [], quoting => shift}, $class; + my $self = bless {name => shift, value => [@_]}, $class; return $self; } @@ -71,28 +75,6 @@ =pod -By default spaces and special characters in values will be quoted/escaped -suitably for use within a Makefile 'command', other valid quoting styles are -'prerequisite' and 'target': - - $var->Quoting ('target'); - -(See L<Panotools::Makefile::Utils> for description of quoting styles) - -The variable name should not require escaping and should consist of safe -letters, numbers and the underscore: A-Z a-z 0-9 _ - -=cut - -sub Quoting -{ - my $self = shift; - $self->{quoting} = shift if @_; - return $self->{quoting}; -} - -=pod - Construct a text fragment that defines this variable suitable for use in a Makefile like so: @@ -103,24 +85,17 @@ sub Assemble { my $self = shift; - return 0 unless defined $self->{name}; + return '' unless defined $self->{name}; my $text; $text .= quotetarget ($self->{name}); $text .= ' = '; - if ($self->{quoting} eq 'target') - { - $text .= join ' ', (map { quotetarget ($_)} @{$self->{value}}); - } - elsif ($self->{quoting} eq 'prerequisite') - { - $text .= join ' ', (map { quoteprerequisite ($_)} @{$self->{value}}); - } - else - { - $text .= join ' ', (map { quoteshell ($_)} @{$self->{value}}); - } + $text .= join ' ', (map { quotetarget ($_)} grep /./, @{$self->{value}}); $text .= "\n"; + $text .= quotetarget ($self->{name} .'_SHELL'); + $text .= ' = '; + $text .= join ' ', (map { quoteshell ($_)} grep /./, @{$self->{value}}); + $text .= "\n"; return $text; } Modified: trunk/Panotools-Script/lib/Panotools/Makefile.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Makefile.pm 2009-11-10 22:45:39 UTC (rev 1146) +++ trunk/Panotools-Script/lib/Panotools/Makefile.pm 2009-11-11 18:40:26 UTC (rev 1147) @@ -22,6 +22,7 @@ use Panotools::Script; use Panotools::Makefile::Rule; use Panotools::Makefile::Variable; +use Panotools::Makefile::Comment; use File::Temp qw/tempdir/; use File::Spec; @@ -47,15 +48,17 @@ Start adding items to the Makefile: -Rule() returns a new L<Panotools::Makefile::Rule> object and Variable() returns -a new L<Panotools::Makefile::Variable> object: +Rule() returns a new L<Panotools::Makefile::Rule> object, Variable() returns a +new L<Panotools::Makefile::Variable> object and Comment() returns a new +L<Panotools::Makefike::Variable> object: - my $var_user = $makefile->Variable ('USER', 'shell'); + my $var_user = $makefile->Variable ('USER'); $var_user->Values ("Dr. Largio d'Apalansius (MB)"); my $rule_all = $makefile->Rule ('all'); - $rule_all->Command ('echo', '$(USER)', '>', 'My File.txt'); + $rule_all->Command ('echo', '$(USER_SHELL)', '>', 'My File.txt'); + $makefile->Comment ('.PHONY target isn't strictly necessary in this case'); my $rule_phony = $makefile->Rule; $rule_phony->Targets ('.PHONY'); $rule_phony->Prerequisites ('all'); @@ -78,6 +81,14 @@ return $variable; } +sub Comment +{ + my $self = shift; + my $comment = new Panotools::Makefile::Comment (@_); + push @{$self->{items}}, $comment; + return $comment; +} + =pod Write the Makefile: This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bru...@us...> - 2009-11-11 18:54:40
|
Revision: 1148 http://panotools.svn.sourceforge.net/panotools/?rev=1148&view=rev Author: brunopostle Date: 2009-11-11 18:54:33 +0000 (Wed, 11 Nov 2009) Log Message: ----------- Fix tests broken by previous commit Modified Paths: -------------- trunk/Panotools-Script/Changes trunk/Panotools-Script/t/105.vars.t Modified: trunk/Panotools-Script/Changes =================================================================== --- trunk/Panotools-Script/Changes 2009-11-11 18:40:26 UTC (rev 1147) +++ trunk/Panotools-Script/Changes 2009-11-11 18:54:33 UTC (rev 1148) @@ -8,6 +8,7 @@ - panostart will get FoV from EXIF data - Split utilities for querying list of photos to Panotools::Photos - erect2cubic --face option to optionally specify cubeface pixel size + - tif2svg,enblend-svg fix --jpeg-proxies option (Thomas Modes) - match-n-shift fix detection of longest exposure in bracketed sets 0.23 Modified: trunk/Panotools-Script/t/105.vars.t =================================================================== --- trunk/Panotools-Script/t/105.vars.t 2009-11-11 18:40:26 UTC (rev 1147) +++ trunk/Panotools-Script/t/105.vars.t 2009-11-11 18:54:33 UTC (rev 1148) @@ -16,28 +16,31 @@ $var->Values ('James Brine', 'George Loveless'); $var->Values ('Thomas Standfield'); -$var->Quoting ('shell'); platform ('MSWin32'); -ok ($var->Assemble =~ /USERS = "James Brine" "George Loveless" "Thomas Standfield"/); +ok ($var->Assemble =~ /USERS_SHELL = "James Brine" "George Loveless" "Thomas Standfield"/); +ok ($var->Assemble =~ /USERS = James\\ Brine George\\ Loveless Thomas\\ Standfield/); platform ('linux'); +ok ($var->Assemble =~ /USERS_SHELL = James\\ Brine George\\ Loveless Thomas\\ Standfield/); ok ($var->Assemble =~ /USERS = James\\ Brine George\\ Loveless Thomas\\ Standfield/); undef $var; -my $var2 = new Panotools::Makefile::Variable ('USERS', 'shell'); +my $var2 = new Panotools::Makefile::Variable ('USERS'); $var2->Values ('James Brine', 'George Loveless'); $var2->Values ('Thomas Standfield'); platform ('MSWin32'); -ok ($var2->Assemble =~ /USERS = "James Brine" "George Loveless" "Thomas Standfield"/); +ok ($var2->Assemble =~ /USERS_SHELL = "James Brine" "George Loveless" "Thomas Standfield"/); +ok ($var2->Assemble =~ /USERS = James\\ Brine George\\ Loveless Thomas\\ Standfield/); platform ('linux'); +ok ($var2->Assemble =~ /USERS_SHELL = James\\ Brine George\\ Loveless Thomas\\ Standfield/); ok ($var2->Assemble =~ /USERS = James\\ Brine George\\ Loveless Thomas\\ Standfield/); This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bru...@us...> - 2009-11-12 23:20:39
|
Revision: 1152 http://panotools.svn.sourceforge.net/panotools/?rev=1152&view=rev Author: brunopostle Date: 2009-11-12 23:20:28 +0000 (Thu, 12 Nov 2009) Log Message: ----------- Add list of stacks to ptoinfo output Modified Paths: -------------- trunk/Panotools-Script/bin/ptoinfo trunk/Panotools-Script/lib/Panotools/Script.pm Modified: trunk/Panotools-Script/bin/ptoinfo =================================================================== --- trunk/Panotools-Script/bin/ptoinfo 2009-11-12 04:12:26 UTC (rev 1151) +++ trunk/Panotools-Script/bin/ptoinfo 2009-11-12 23:20:28 UTC (rev 1152) @@ -19,6 +19,12 @@ print STDOUT ' '. (join ': ', @{$item}) ."\n"; } + print STDOUT ' Number of stacks: '. scalar (@{$pto->Stacks}) ."\n"; + for my $index (0 .. @{$pto->Stacks} -1) + { + print STDOUT " Stack $index: ". join (', ', @{$pto->Stacks->[$index]}) ."\n"; + } + # summarise control points my $results = {}; for my $control (@{$pto->Control}) Modified: trunk/Panotools-Script/lib/Panotools/Script.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Script.pm 2009-11-12 04:12:26 UTC (rev 1151) +++ trunk/Panotools-Script/lib/Panotools/Script.pm 2009-11-12 23:20:28 UTC (rev 1152) @@ -705,7 +705,6 @@ my $self = shift->Clone; my $stacks = []; my $maxShift = $self->Image->[0]->{v} / 10.0; - my $minShift = 360.0 - $maxShift; my @images = (0 .. scalar @{$self->Image} -1); while (@images) { @@ -714,18 +713,11 @@ my @images_remaining = @images; for my $image (@images) { - if ( (abs ($self->{image}->[$base_image]->{y} - $self->{image}->[$image]->{y}) < $maxShift - || abs ($self->{image}->[$base_image]->{y} - $self->{image}->[$image]->{y}) > $minShift) - && abs ($self->{image}->[$base_image]->{p} - $self->{image}->[$image]->{p}) < $maxShift ) + if (_stacked ($self->{image}->[$base_image], $self->{image}->[$image], $maxShift)) { push @{$stack}, $image; - shift @images_remaining; + @images_remaining = grep !/^$image$/, @images_remaining; } - else - { - @images = @images_remaining; - last; - } } @images = @images_remaining; push @{$stacks}, $stack; @@ -733,6 +725,16 @@ return $stacks; } +sub _stacked +{ + my ($image0, $image1, $maxShift) = @_; + my $minShift = 360.0 - $maxShift; + return 1 + if ( (abs ($image0->{y} - $image1->{y}) < $maxShift || abs ($image0->{y} - $image1->{y}) > $minShift) + && abs ($image0->{p} - $image1->{p}) < $maxShift ); + return 0; +} + =head1 COPYRIGHT Copyright (c) 2001 Bruno Postle <br...@po...>. All Rights Reserved. This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |
From: <bru...@us...> - 2009-11-13 22:59:47
|
Revision: 1153 http://panotools.svn.sourceforge.net/panotools/?rev=1153&view=rev Author: brunopostle Date: 2009-11-13 22:59:39 +0000 (Fri, 13 Nov 2009) Log Message: ----------- ExposureLayers() method Modified Paths: -------------- trunk/Panotools-Script/bin/ptoinfo trunk/Panotools-Script/lib/Panotools/Script.pm Modified: trunk/Panotools-Script/bin/ptoinfo =================================================================== --- trunk/Panotools-Script/bin/ptoinfo 2009-11-12 23:20:28 UTC (rev 1152) +++ trunk/Panotools-Script/bin/ptoinfo 2009-11-13 22:59:39 UTC (rev 1153) @@ -25,6 +25,12 @@ print STDOUT " Stack $index: ". join (', ', @{$pto->Stacks->[$index]}) ."\n"; } + print STDOUT ' Number of exposure layers: '. scalar (@{$pto->ExposureLayers}) ."\n"; + for my $index (0 .. @{$pto->ExposureLayers} -1) + { + print STDOUT " Layer $index: ". join (', ', @{$pto->ExposureLayers->[$index]}) ."\n"; + } + # summarise control points my $results = {}; for my $control (@{$pto->Control}) Modified: trunk/Panotools-Script/lib/Panotools/Script.pm =================================================================== --- trunk/Panotools-Script/lib/Panotools/Script.pm 2009-11-12 23:20:28 UTC (rev 1152) +++ trunk/Panotools-Script/lib/Panotools/Script.pm 2009-11-13 22:59:39 UTC (rev 1153) @@ -700,6 +700,22 @@ return sqrt ($variance); } +=pod + +Split the project into exposure stacks based in roll, pitch & yaw, or into +exposure layers based on EV values: + + $stacks = $pto->Stacks; + $layers = $pto->ExposureLayers; + +Returns a list of image number lists. + +e.g. extract the first stack as a new project: + + $pto_stack = $pto->Subset (@{$pto->Stacks->[0]}); + +=cut + sub Stacks { my $self = shift->Clone; @@ -713,7 +729,7 @@ my @images_remaining = @images; for my $image (@images) { - if (_stacked ($self->{image}->[$base_image], $self->{image}->[$image], $maxShift)) + if (_samestack ($self->{image}->[$base_image], $self->{image}->[$image], $maxShift)) { push @{$stack}, $image; @images_remaining = grep !/^$image$/, @images_remaining; @@ -725,7 +741,7 @@ return $stacks; } -sub _stacked +sub _samestack { my ($image0, $image1, $maxShift) = @_; my $minShift = 360.0 - $maxShift; @@ -735,6 +751,38 @@ return 0; } +sub ExposureLayers +{ + my $self = shift->Clone; + my $layers = []; + my $maxEVDiff = 0.5; + my @images = (0 .. scalar @{$self->Image} -1); + while (@images) + { + my $base_image = shift @images; + my $layer = [$base_image]; + my @images_remaining = @images; + for my $image (@images) + { + if (_samelayer ($self->{image}->[$base_image], $self->{image}->[$image], $maxEVDiff)) + { + push @{$layer}, $image; + @images_remaining = grep !/^$image$/, @images_remaining; + } + } + @images = @images_remaining; + push @{$layers}, $layer; + } + return $layers; +} + +sub _samelayer +{ + my ($image0, $image1, $maxEVDiff) = @_; + return 1 if (abs ($image0->{Eev} - $image1->{Eev}) < $maxEVDiff ); + return 0; +} + =head1 COPYRIGHT Copyright (c) 2001 Bruno Postle <br...@po...>. All Rights Reserved. This was sent by the SourceForge.net collaborative development platform, the world's largest Open Source development site. |