view release on metacpan or  search on metacpan

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

# mamgal - a program for creating static image galleries
# Copyright 2007-2012 Marcin Owsiany <marcin@owsiany.pl>
# See the README file for license information
# The directory encapsulating class
package App::MaMGal::Entry::Dir;
use strict;
use warnings;
use base 'App::MaMGal::Entry';
use Carp;
use App::MaMGal::Entry::Picture;
use App::MaMGal::DirIcon;
use Image::Magick;
use App::MaMGal::Exceptions;

sub child            { $_[0]->{path_name}.'/'.$_[1]     }
sub page_path        { $_[0]->{base_name}.'/index.html' }
sub thumbnail_path   { $_[0]->{base_name}.'/.mamgal-index.png'  }

sub init
{
	my $self = shift;
	$self->SUPER::init(@_);
	if ($self->{dir_name} eq '/' and ($self->{base_name} eq '/' or $self->{base_name} eq '.')) {
		$self->{path_name} = '/';
		$self->{base_name} = '/';
		$self->{is_root} = 1;
	} elsif (-e $self->child('.mamgal-root')) {
		$self->{is_root} = 1;
	}
}

sub set_root
{
	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
{
	my $self = shift;
	my $tools = $self->tools or croak "Tools were not injected";
	my $formatter = $tools->{formatter} or croak "Formatter required";
	ref $formatter and $formatter->isa('App::MaMGal::Formatter') or croak "[$formatter] is not a formatter";

	my $deleted_css = $self->_write_stylesheet;
	# Force a rewrite of all html pages if the stylesheet was removed, as they now need to point to a different place
	my @active_files = map { $_->make(force_slide => $deleted_css) } $self->elements;
	my $pruned_count = $self->_prune_inactive_files(\@active_files);
	$self->_write_montage($pruned_count);
	$self->_write_index($deleted_css or $pruned_count);
	return ()
}

sub _write_index
{
	my $self = shift;
	my $force = shift;

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

	my ($prev, $next);
	my $i = $idx - 1;
	while ($i >= 0) {
		$prev = $elements[$i], last if $elements[$i]->isa('App::MaMGal::Entry::Picture');
		$i--;
	}
	$i = $idx + 1;
	while ($i < scalar @elements) {
		$next = $elements[$i], last if $elements[$i]->isa('App::MaMGal::Entry::Picture');
		$i++;
	}
	return $prev, $next;
}


sub _write_contents_to
{
	my $self = shift;
	my $code = shift;
	my $suffix = shift;
	# TODO: this will be an issue when mamgal goes multi-threaded
	my $tmp_name = $self->child('.mamgal-tmp');
	my $full_name = $self->child($suffix);
	$self->SUPER::_write_contents_to($code, $tmp_name, $full_name);
}

sub _side_length
{
	my $self = shift;
	my $picture_count = shift;

	# The montage is a visual clue that the object is a container.
	# Therefore ensure we do not get a 1x1 montage, because it would be
	# indistinguishable from a single image.
	my $sqrt = sqrt($picture_count);
	my $int = int($sqrt);
	my $side = $int == $sqrt ? $int : $int + 1;
	$side = 2 if $side < 2;
	return $side;
}

sub _write_montage
{
	my $self = shift;
	my $pruned_files = shift;

	my @images = $self->_all_interesting_elements;

	unless (@images) {
		$self->_write_contents_to(sub { App::MaMGal::DirIcon->img }, '.mamgal-index.png');
		return;
	}

	my $montage_path = $self->child('.mamgal-index.png');
	# 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);
	return 0;
}

sub _prune_inactive_files
{
	my $self = shift;
	my $active_files = shift;
	# delete old temporary file, if any
	unlink $self->child('.mamgal-tmp') if (-e $self->child('.mamgal-tmp'));
	my @known_subdirs = ($self->slides_dir, $self->thumbnails_dir, $self->medium_dir);
	# first, sanity check so we know if we start creating files outside the known subdirs
	foreach my $f (@$active_files) {
		confess "internal error: [$f] has an unknown prefix" unless
			substr($f, 0, length($known_subdirs[0]) + 1) eq $known_subdirs[0].'/' or
			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++;