throw results from the CPAN

throw

App-MaMGal

view release on metacpan or search on metacpan

	my $method = $AUTOLOAD;
	$method =~ s/.*://;
	croak "Unknown method $method" unless $method =~ /^make_(without_)?roots$/;
	eval {
		$self->{maker}->$method(@_);
	};
	my $e;
	if ($e = Exception::Class->caught('App::MaMGal::SystemException')) {
		$self->{logger}->log_exception($e);
	} elsif ($e = Exception::Class->caught) {
		ref $e ? $e->rethrow : die $e;
	}
	1;
}

1;

lib/App/MaMGal/Base.pm view on Meta::CPAN


#######################################################################################################################
# Utility methods
sub _write_contents_to
{
	my $self = shift;
	my $code = shift;
	my $tmp_name = shift;
	my $full_name = shift;

	open(OUT, '>', $tmp_name)     or App::MaMGal::SystemException->throw(message => '%s: open failed: %s', objects => [$tmp_name, $!]);
	print OUT &$code;
	close(OUT)                    or App::MaMGal::SystemException->throw(message => '%s: close failed: %s', objects => [$tmp_name, $!]);
	rename($tmp_name, $full_name) or App::MaMGal::SystemException->throw(message => '%s: rename failed from "%s": %s', objects => [$full_name, $tmp_name, $!]);
}

1;

lib/App/MaMGal/Entry/Dir.pm view on Meta::CPAN

{
	my $self = shift;
	my $was_root = $self->is_root;
	my $is_root = $self->{is_root} = shift; 

	return if $is_root == $was_root;

	if ($is_root) {
		$self->_write_contents_to(sub {''}, '.mamgal-root');
	} else {
		unlink($self->child('.mamgal-root')) or App::MaMGal::SystemException->throw(message => '%s: unlink failed: %s', objects => [$self->child(".mamgal-root"), $!]);
	}
}

sub is_root
{
	my $self = shift;
	return $self->{is_root} || 0;
}

sub make

lib/App/MaMGal/Entry/Dir.pm view on Meta::CPAN

{
	my $self = shift;
	if ($self->is_root) {
		my $formatter = $self->tools->{formatter};
		$self->_write_contents_to(sub { $formatter->stylesheet    }, '.mamgal-style.css');
	} else {
		# Delete legacy stylesheet files in directories other than root.
		# TODO: remove this code a few releases from 1.2
		my $path = $self->child('.mamgal-style.css');
		return unless -e $path;
		unlink($path) or App::MaMGal::SystemException->throw(message => '%s: unlink failed: %s', objects => [$path, $!]);
		return 1;
	}
}

sub ensure_subdir_exists
{
	my $self = shift;
	my $basename = shift;
	my $dir = $self->child($basename);
	mkdir $dir or App::MaMGal::SystemException->throw(message => '%s: mkdir failed: %s', objects => [$dir, $!]) unless -w $dir;
}

# get _picture_ neighbours of given picture
sub neighbours_of_index
{
	my $self = shift;
	my $idx  = shift;
	croak "neighbours_of_index must run in array context" unless wantarray;
	my @elements = $self->elements;
	$idx >= 0 or croak "Pic index must be at least 0";

lib/App/MaMGal/Entry/Dir.pm view on Meta::CPAN

	# Return early if the montage is fresh
	return if $self->fresher_than_me($montage_path, consider_interesting_only => 1) and $pruned_files == 0;

	# Get just a bunch of images, not all of them.
	my $montage_count = scalar @images > 36 ? 36 : scalar @images;
	# Stack them all together
	my $stack = Image::Magick->new;
	push @$stack, map {
		my $img = Image::Magick->new;
		my $rr;
		$rr = $img->Read($_->tile_path) and App::MaMGal::SystemException->throw(message => '%s: %s', objects => [$_->tile_path, $rr]);
		$img->[0] or $img } @images[0..($montage_count-1)];

	my $side = $self->_side_length($montage_count);

	my ($m_x, $m_y) = (200, 150);

	my ($montage, $r);
	# Do the magick, scale and write.
	$r = $montage = $stack->Montage(tile => $side.'x'.$side, geometry => $m_x.'x'.$m_y, border => 2);
	ref($r)                                                            or  App::MaMGal::SystemException->throw(message => '%s: montage failed: %s',         objects => [$montage_path, $r]);
	$r = App::MaMGal::Entry::Picture->scale_into($montage, $m_x, $m_y) and App::MaMGal::SystemException->throw(message => '%s: scaling failed: %s',         objects => [$montage_path, $r]);
	$r = $montage->Write($montage_path)                                and App::MaMGal::SystemException->throw(message => '%s: writing montage failed: %s', objects => [$montage_path, $r]);
}

sub _ignorable_name($)
{
	my $self = shift;
	my $name = shift;
	# ignore hidden files
	return 1 if substr($_, 0, 1) eq '.';
	# TODO: optimize out contants calls, keeping in mind that they are not really constant (eg. tests change them when testing slides/miniatures generation)
	return 1 if grep { $_ eq $name } (qw(lost+found index.html .mamgal-index.png .mamgal-style.css), $self->slides_dir, $self->thumbnails_dir, $self->medium_dir);

lib/App/MaMGal/Entry/Dir.pm view on Meta::CPAN

			substr($f, 0, length($known_subdirs[1]) + 1) eq $known_subdirs[1].'/' or
			substr($f, 0, length($known_subdirs[2]) + 1) eq $known_subdirs[2].'/';
	}
	my %active = map { $_ => 1 } @$active_files;
	my $base = $self->{path_name};
	my $pruned_count = 0;
	foreach my $dir (@known_subdirs) {
		# If the directory is not there, we have nothing to do about it
		next unless -d $base.'/'.$dir;
		# Read the names from the dir
		opendir DIR, $base.'/'.$dir or App::MaMGal::SystemException->throw(message => '%s: opendir failed: %s',  objects => ["$base/$dir", $!]);
		my @entries = grep { $_ ne '.' and $_ ne '..' } readdir DIR;
		closedir DIR                or App::MaMGal::SystemException->throw(message => '%s: closedir failed: %s', objects => ["$base/$dir", $!]);
		# Delete the files which are not "active"
		my $at_start = scalar @entries;
		my $deleted = 0;
		foreach my $entry (@entries) {
			next if $active{$dir.'/'.$entry};
			# Before unlinking, update touch self so that if we crash between unlinking and updating thumbnail, it will be done on subsequent invocation.
			utime(undef, undef, $base);
			unlink($base.'/'.$dir.'/'.$entry) or App::MaMGal::SystemException->throw(message => '%s: unlink failed: %s', objects => ["$base/$dir/$entry", $!]);
			$deleted++;
		}
		$pruned_count += $deleted;
		rmdir($base.'/'.$dir) or App::MaMGal::SystemException->throw(message => '%s: rmdir failed: %s', objects => ["$base/$dir", $!]) if $at_start == $deleted;
	}
	return $pruned_count;
}

sub elements
{
	my $self = shift;
	# Lookup the cache
	return @{$self->{elements}} if exists $self->{elements};

	# Get entry factory
	my $tools = $self->tools or croak "Tools were not injected";
	my $entry_factory = $tools->{entry_factory} or croak "Entry factory required";
	ref $entry_factory and $entry_factory->isa('App::MaMGal::EntryFactory') or croak "[$entry_factory] is not an entry factory";

	# Read the names from the dir
	my $path = $self->{path_name};
	opendir DIR, $path or App::MaMGal::SystemException->throw(message => '%s: opendir failed: %s',  objects => [$path, $!]);
	my @entries = sort { $a cmp $b } grep { ! $self->_ignorable_name($_) } readdir DIR;
	closedir DIR       or App::MaMGal::SystemException->throw(message => '%s: closedir failed: %s', objects => [$path, $!]);

	my $i = 0;
	# Instantiate objects and cache them
	$self->{elements} = [ map {
			$_ = $path.'/'.$_ ;
			my $e = $entry_factory->create_entry_for($_);
			$e->set_element_index($i++);
			$e->set_container($self);
			$e
		} @entries

lib/App/MaMGal/Entry/Picture.pm view on Meta::CPAN

	my $r;
	my @ret;
	foreach my $miniature (@miniatures) {
		my ($subdir, $x, $y, $suffix) = @$miniature;
		my $relative_name = $subdir.'/'.$self->{base_name}.($suffix ? $suffix : '');
		push @ret, $relative_name;
		my $name = $self->{dir_name}.'/'.$relative_name;
		next if $self->fresher_than_me($name);
		# loading image data deferred until it's necessary
		$i = $self->read_image unless defined $i;
		$r = $self->scale_into($i, $x, $y) and App::MaMGal::SystemException->throw(message => '%s: scaling failed: %s', objects => [$name, $r]);
		$self->container->ensure_subdir_exists($subdir);
		$r = $i->Write($name)              and App::MaMGal::SystemException->throw(message => '%s: writing failed: %s', objects => [$name, $r]);
	}
	return @ret;
}

sub is_interesting { 1; }
sub page_path { $_[0]->slides_dir.'/'.$_[0]->{base_name}.'.html' }
sub thumbnail_path { $_[0]->thumbnails_dir.'/'.$_[0]->{base_name} }
sub tile_path { $_[0]->{dir_name}.'/'.$_[0]->thumbnail_path }

# This method does not operate on App::MaMGal::Entry::Picture, but this was the most

lib/App/MaMGal/Entry/Picture/Static.pm view on Meta::CPAN

	my $self = shift;
	my $i = $self->image_info or return;
	return $i->description;
}

sub read_image
{
	my $self = shift;
	my $i = Image::Magick->new;
	my $r;
	$r = $i->Read($self->{path_name}) and App::MaMGal::SystemException->throw(message => '%s: reading failed: %s', objects => [$self->{path_name}, $r]);
	return $i;
}

sub creation_time
{
	my $self = shift;
	my $info = $self->image_info or return $self->SUPER::creation_time(@_);
	return $info->creation_time || $self->SUPER::creation_time(@_);
}

lib/App/MaMGal/EntryFactory.pm view on Meta::CPAN

}


sub create_entry_for
{
	my $self = shift;
	my $path_arg = shift or croak "Need path"; # absolute, or relative to CWD
	croak "Need 1 arg, got more: [$_[0]]" if @_;

	my ($path, $dirname, $basename) = canonicalize_path($path_arg);
	my $lstat = lstat($path) or App::MaMGal::SystemException->throw(message => '%s: getting status failed: %s', objects => [$path, $!]);
	my $stat = $lstat;
	if ($lstat->mode & S_IFLNK) {
		$stat = stat($path);
	}

	my $e;
	if (not $stat) {
		$e = App::MaMGal::Entry::BrokenSymlink->new($dirname, $basename, $lstat)

	} elsif ($stat->mode & S_IFDIR) {

lib/App/MaMGal/ImageInfoFactory.pm view on Meta::CPAN


BEGIN {
	if (exists $ENV{MAMGAL_FORCE_IMAGEINFO}) {
		$implementation = $ENV{MAMGAL_FORCE_IMAGEINFO};
		eval "require $implementation" or die;
	} elsif (eval "require App::MaMGal::ImageInfo::ExifTool") {
		$implementation = 'App::MaMGal::ImageInfo::ExifTool';
	} elsif (eval "require App::MaMGal::ImageInfo::ImageInfo") {
		$implementation = 'App::MaMGal::ImageInfo::ImageInfo';
	} else {
		App::MaMGal::SystemException->throw(message => 'No usable image info library found (looked for "Image::ExifTool" and "Image::Info" in %s).', objects => [join(':', @INC)]);;
	}
}

sub init
{
	my $self = shift;
	my $parser = shift or croak "A Image::EXIF::DateTime::Parser argument is required";
	ref $parser and $parser->isa('Image::EXIF::DateTime::Parser') or croak "Arg is not an Image::EXIF::DateTime::Parser , but a [$parser]";
	my $logger = shift or croak "A App::MaMGal::Logger argument is required";
	ref $logger and $logger->isa('App::MaMGal::Logger') or croak "Arg is not an App::MaMGal::Logger, but a [$logger]";

lib/App/MaMGal/Maker.pm view on Meta::CPAN


sub _make_any
{
	my $self = shift;
	my $dirs_are_roots = shift;
	# TODO: replace with croak after cmdline parsing is added
	die "Argument required.\n" unless @_;

	my @dirs = map {
		my $d = $self->{entry_factory}->create_entry_for($_);
		App::MaMGal::SystemException->throw(message => '%s: not a directory.', objects => [$_]) unless $d->isa('App::MaMGal::Entry::Dir');
		$d->set_root(1) if $dirs_are_roots;
		$d
	} @_;
	$_->make foreach @dirs;

	return 1;
}

1;

lib/App/MaMGal/MplayerWrapper.pm view on Meta::CPAN


sub init
{
	my $self = shift;
	my $cc = shift or croak 'Arg required: command checker';
	$cc->isa('App::MaMGal::CommandChecker') or croak 'Arg must be a CommandChecker';
	croak "Just one argument allowed" if @_;
	eval {
		$self->{tempdir} = tempdir(CLEANUP => 1);
	}; if ($@) {
		App::MaMGal::SystemException->throw(message => 'Temporary directory creation failed: %s.', objects => [$@]);
	}
	$self->{cc} = $cc;
}

sub run_mplayer
{
	my $self = shift;
	my $film_path = shift;
	my $dir = $self->{tempdir};
	my $pid = fork;
	if (not defined $pid) {
		App::MaMGal::MplayerWrapper::ExecutionFailureException->throw("Fork failed: $!");
	} elsif ($pid == 0) {
		# Child
		open(STDOUT, ">${dir}/stdout") or App::MaMGal::MplayerWrapper::ExecutionFailureException->throw("Cannot open \"${dir}/stdout\" for writing: $!");
		open(STDERR, ">${dir}/stderr") or App::MaMGal::MplayerWrapper::ExecutionFailureException->throw("Cannot open \"${dir}/stderr\" for writing: $!");
		my @cmd = ('mplayer', $film_path, '-noautosub', '-nosound', '-vo', "jpeg:quality=100:outdir=${dir}", '-frames', '2');
		{ # own scope to prevent a compile-time warning
		exec(@cmd);
		}
		App::MaMGal::MplayerWrapper::ExecutionFailureException->throw("Cannot run mplayer: $!");
	} else {
		# Parent
		waitpid($pid, 0);
		App::MaMGal::MplayerWrapper::ExecutionFailureException->throw("Mplayer failed ($?).", $self->_read_messages) if $? != 0;
	}
}

sub _read_log
{
	my $self = shift;
	my $name = shift;
	my $dir = $self->{tempdir};
	open(F, "<${dir}/$name") or App::MaMGal::MplayerWrapper::ExecutionFailureException->throw("Cannot open \"${dir}/$name\" for reading: $!");
	my @ret = <F>;
	close(F) or App::MaMGal::MplayerWrapper::ExecutionFailureException->throw("Cannot close \"${dir}/$name\": $!");
	chomp @ret;
	return \@ret;
}

sub _read_messages
{
	my $self = shift;
	return map { $_ => $self->_read_log($_) } qw(stdout stderr);
}

sub snapshot
{
	my $self = shift;
	$self->{available} = $self->{cc}->is_available('mplayer') unless exists $self->{available};
	App::MaMGal::MplayerWrapper::NotAvailableException->throw unless $self->{available};
	my $film_path = shift or croak "snapshot needs an arg: path to the film";
	-r $film_path or App::MaMGal::SystemException->throw(message => '%s: not readable', objects => [$film_path]);
	my $dir = $self->{tempdir};
	$self->run_mplayer($film_path);
	my $img = Image::Magick->new;
	if (my $r = $img->Read("${dir}/00000001.jpg")) {
		App::MaMGal::MplayerWrapper::ExecutionFailureException->throw(message => "Could not read the snapshot produced by mplayer: $r", $self->_read_messages);
	}
	$self->cleanup;
	return $img;
}

sub cleanup
{
	my $self = shift;
	my $path = $self->{tempdir};
	opendir my $d, $path or App::MaMGal::MplayerWrapper::ExecutionFailureException->throw("Cannot open \"$path\" to clean up after mplayer");
	my @files = readdir $d;
	closedir $d;
	# This assumes that mplayer did not create any directories.
	unlink(map($path.'/'.$_, @files));
}

1;

t/100_unit_maker.t view on Meta::CPAN

	$ef_dir->set_isa('App::MaMGal::EntryFactory');
	my $maker;
	lives_ok(sub { $maker = App::MaMGal::Maker->new($ef_dir) }, "maker creation succeeds an entry factory arg");
	isa_ok($maker, 'App::MaMGal::Maker');
	$self->{maker} = $maker;
}

sub make_roots_dies_without_args : Test(2)
{
	my $self = shift;
	throws_ok { $self->{maker}->make_roots } qr{^Argument required\.$}, "maker dies on no args";
	throws_ok { $self->{maker}->make_without_roots } qr{^Argument required\.$}, "maker dies on no args";
}

package App::MaMGal::Unit::Maker::Normal;
use strict;
use warnings;
use Carp;
use Carp 'verbose';
use base 'App::MaMGal::Unit::Maker::Base';

use Test::More;

t/100_unit_maker.t view on Meta::CPAN

sub set_mock_entry
{
	my $self = shift;
	my $mock_entry = $self->{mock_entry} = get_mock_entry('App::MaMGal::Entry::SomethinElse');
	return sub { $mock_entry };
}

sub make_roots_dies : Test(1)
{
	my $self = shift;
	throws_ok { $self->{maker}->make_roots('something/whatever') } qr{^%s: not a directory\.$}, "maker dies if thing returned by factory is not a dir object";
}

sub make_without_roots_dies : Test(1)
{
	my $self = shift;
	throws_ok { $self->{maker}->make_without_roots('something/whatever') } qr{^%s: not a directory\.$}, "maker dies if thing returned by factory is not a dir object";
}



package App::MaMGal::Unit::Maker::Crash;
use strict;
use warnings;
use Carp;
use Carp 'verbose';
use base 'App::MaMGal::Unit::Maker::Base';

t/100_unit_maker.t view on Meta::CPAN


sub set_mock_entry
{
	return sub { die 'dying here on purpose' };
}


sub make_roots_dies : Test(1)
{
	my $self = shift;
	throws_ok { $self->{maker}->make_roots('something/whatever') } qr{^dying here on purpose}, "maker dies if factory call crashes";
}

sub make_without_roots_dies : Test(1)
{
	my $self = shift;
	throws_ok { $self->{maker}->make_without_roots('something/whatever') } qr{^dying here on purpose}, "maker dies if factory call crashes";
}


package main;
use strict;
use warnings;
use Test::More;
unless (defined caller) {
	plan tests =>
		App::MaMGal::Unit::Maker::Normal->expected_tests +

t/100_unit_mplayer_wrapper.t view on Meta::CPAN

dies_ok(sub { $w->snapshot() },				"wrapper cannot get a snapshot of undef");
my ($m, $args) = $mccy->next_call;
is($m, 'is_available', 'checker is interrogated on fist wrapper use');
is_deeply($args, [$mccy, 'mplayer'], 'checker is asked about mplayer');
$mccy->clear;

dies_ok(sub { $w->snapshot('td/notthere.mov') },	"wrapper cannot get a snapshot of an inexistant file");
is($mccy->next_call, undef, 'checker not interrogated more than once');
$mccy->clear;

throws_ok(sub { $snap = $w->snapshot('td/c.jpg') }, 'App::MaMGal::MplayerWrapper::ExecutionFailureException', "wrapper cannot survive snapshotting a non-film file");
my $err = $@;
is($mccy->next_call, undef, 'checker not interrogated more than once');
$mccy->clear;
ok($err->message, "invalid file produces some exception message");
ok($err->stdout, "invalid file produces some messages");
cmp_ok(scalar @{$err->stdout}, '>', 0, "there are lines in the stdout file");
is(scalar(grep(/\n$/, @{$err->stdout})), 0, "no newlines in the stdout file");
ok($err->stderr, "invalid file produces some error messages");
cmp_ok(scalar @{$err->stderr}, '>', 0, "there are lines in the stderr file");
is(scalar(grep(/\n$/, @{$err->stderr})), 0, "no newlines in the stderr file");

t/100_unit_mplayer_wrapper.t view on Meta::CPAN

}

{
my $mccn = get_mock_cc(0);
my $w;
lives_ok(sub { $w = App::MaMGal::MplayerWrapper->new($mccn) },        "wrapper can be created with command checker");

is($mccn->next_call, undef, 'checker not interrogated until fist wrapper use');
$mccn->clear;

throws_ok(sub { $w->snapshot() }, 'App::MaMGal::MplayerWrapper::NotAvailableException', "failed because mplayer was not found");
my ($m, $args) = $mccn->next_call;
is($m, 'is_available', 'checker is interrogated on fist wrapper use');
is_deeply($args, [$mccn, 'mplayer'], 'checker is asked about mplayer');
$mccn->clear;

throws_ok(sub { $w->snapshot('td/notthere.mov') }, 'App::MaMGal::MplayerWrapper::NotAvailableException', "failed because mplayer was not found");
is($mccn->next_call, undef, 'checker not interrogated more than once');
$mccn->clear;

throws_ok(sub { $w->snapshot('td/c.jpg') }, 'App::MaMGal::MplayerWrapper::NotAvailableException', "failed because mplayer was not found");
is($mccn->next_call, undef, 'checker not interrogated more than once');
$mccn->clear;

throws_ok(sub { $w->snapshot('td/one_film/m.mov') }, 'App::MaMGal::MplayerWrapper::NotAvailableException', "failed because mplayer was not found");
is($mccn->next_call, undef, 'checker not interrogated more than once');
$mccn->clear;
}

( run in 0.303 second using v1.01-cache-2.11-cpan-496ff517765 )