view release on metacpan or  search on metacpan

script/album  view on Meta::CPAN

my $largepat;
sub basename_nolarge {
    my ($f) = @_;
    unless ( $largepat ) {
	$largepat = quotemeta(::d_large());
	$largepat = qr;^$largepat[/\\];;
    }
    $f =~ s;$largepat;;;
    $f;
}

sub new {
    my ($pkg, $file) = @_;
    $pkg = ref($pkg) if ref($pkg);

    my $self = { $file ?
		 (orig_name    => $file,
		  dest_name    => basename_nolarge($file)) : (),
		 description  => "",
		 annotation   => [],
		 tag	      => "",
	       };

    if ( $file && -f $file ) {
	my @st = stat(_);
	my $ii = ::cache_entry($file);
	if ( $ii  ){
	    $self = $ii;
	    delete($self->{$_}) foreach grep { /^_/ } keys(%$self);
	}

	# Else, get image info.
	else {
	    my $ii = Image::Info::image_info($file);
	    $self->{file_size} = $st[7];
	    $self->{timestamp} = $st[9];
	    unless ( exists($ii->{error}) ) {
		for my $key ( @exif_fields ) {
		    my $val = $ii->{$key};
		    next unless defined $val;
		    if ( $key eq "Orientation" ) {
			($self->{rotation}, $self->{mirror}) =
			  @{$exif_rot->{$val}}
			    if exists $exif_rot->{$val};
		    }
		    else {
			$val = $val->as_float
			  if UNIVERSAL::can($val,"as_float");
			$self->{$key} = $val;
		    }
		}
		::cache_entry($file, $self);
	    }
	}
	# Actualize.
	$self->{file_size} = $st[7];
	$self->{timestamp} = $st[9];
    }

    bless($self, $pkg);
}

INIT {
    no strict 'refs';
    for my $sub ( @std_fields, @exif_fields ) {
	$sub = "_".$sub if $sub eq "rotation";
	*{"ImageInfo::$sub"} = sub {
	    my ($self, $value) = @_;
	    $self->{$sub} = $value if defined($value);
	    $self->{$sub};
	};
    }
}

sub rotation  {
    my ($self) = @_;
    defined($self->{_rotation}) ? $self->{_rotation} : $self->{rotation};
}

sub html_name {
    my ($self) = @_;
    sprintf("img%04d.html", $self->seq);
}

package FileList;

use Class::Struct "FileList" =>
  [ _tally	=> '$',
    _data       => '$',
    _hash	=> '$',
  ];

sub add {
    my ($self, $el, $name) = @_;
    my $data = $self->_data;
    my $hash = $self->_hash;
    $self->_hash($hash = {}) unless $hash;
    $self->_data($data = []) unless $data;
    push(@$data, $el);
    $hash->{$name || $el->dest_name || ""} = $el;
    $self->_tally(($self->_tally||0)+1);
    $el->seq($self->_tally);
    $self;
}

sub byname {
    my ($self, $file) = @_;
    $self->_hash ? $self->_hash->{$file} : undef;
}

sub entries {
    my ($self) = @_;
    $self->_data([]) unless $self->_data;
    wantarray ? @{$self->_data} : $self->_data;
}

sub tally {
    my ($self) = @_;
    $self->_tally || 0;
}

sub byseq {
    my ($self, $seq) = @_;
    $self->_data ? $self->_data->[$seq-1] : undef;
}

#### Cache maintenance.

package ImageInfoCache;

use constant CACHE_VERSION => 3;

sub new {
    my ($pkg, $file) = @_;
    $pkg = ref($pkg) || $pkg;
    my $self = bless({}, $pkg);
    if ( defined($file) ) {
	$self->load($file);
	if ( ($self->{_version} || 1) != CACHE_VERSION ) {
	    warn("Incompatible cache version " . $self->version .
		 " -- invalidated\n") if $verbose;
	    $self = bless({}, $pkg);
	}
    }
    $self->{_version} = CACHE_VERSION;
    $self;
}

sub load {
    my ($self, $file) = @_;
    our $info;
    $info = undef;
    eval {
	require $file;
    };
    if ( $@ ) {
	warn("Illegal cache -- invalidated\n") if $verbose;
	return;
    }
    @{$self}{keys(%$info)} = values(%$info);
}

sub store {
    my ($self, $file) = @_;
    $Data::Dumper::Indent = 1;
    $Data::Dumper::Sortkeys = 1;
    $Data::Dumper::Sortkeys = 1; # avoid warnings
    $Data::Dumper::Purity = 1;
    my $cache = do { local *C; *C };
    open($cache, ">$file")
      and print $cache (Data::Dumper->Dump([$self],[qw(info)]), "\n1;\n")
	and close($cache);
}

sub entry {
    my ($self, $file, $entry) = @_;
    $file =~ s;^\./;;;
    if ( defined $entry ) {
	$self->{$file} = $entry;
    }
    else {
	$entry = $self->{$file};
    }
    $entry;
}

sub entries {
    my ($self) = @_;
    [ sort(keys(%{$self})) ];
}

sub version {
    my ($self) = @_;
    $self->{_version};
}

package main;

=head1 NAME

Album - create and maintain HTML based photo albums