File Coverage

blib/lib/App/MaMGal/EntryFactory.pm
Criterion Covered Total %
statement 13 15 86.6
branch n/a
condition n/a
subroutine 5 5 100.0
pod n/a
total 18 20 90.0


line stmt bran cond sub pod time code
1             # mamgal - a program for creating static image galleries
2             # Copyright 2007, 2008 Marcin Owsiany
3             # See the README file for license information
4             # A helper class which knows how to create Entry subclass objects from paths
5             package App::MaMGal::EntryFactory;
6 1     1   7696 use strict;
  1         2  
  1         23  
7 1     1   4 use warnings;
  1         2  
  1         22  
8 1     1   4 use Carp;
  1         2  
  1         46  
9 1     1   4 use base 'App::MaMGal::Base';
  1         1  
  1         464  
10 1     1   672 use App::MaMGal::Entry::Dir;
  0            
  0            
11             use App::MaMGal::Entry::Picture;
12             use App::MaMGal::Entry::Picture::Static;
13             use App::MaMGal::Entry::Picture::Film;
14             use App::MaMGal::Entry::NonPicture;
15             use App::MaMGal::Entry::BrokenSymlink;
16             use App::MaMGal::Entry::Unreadable;
17             use App::MaMGal::Exceptions;
18             use File::stat;
19             use Fcntl ':mode';
20             use Cwd;
21             use Locale::gettext;
22              
23             sub init
24             {
25             my $self = shift;
26             my $formatter = shift or croak "Need a formatter arg";
27             ref $formatter and $formatter->isa('App::MaMGal::Formatter') or croak "Arg is not a formatter, but a [$formatter]";
28             my $mplayer_wrapper = shift or croak "Need an mplayer wrapper arg";
29             ref $mplayer_wrapper and $mplayer_wrapper->isa('App::MaMGal::MplayerWrapper') or croak "Arg is not an mplayer wrapper, but a [$mplayer_wrapper]";
30             my $image_info_factory = shift or croak "Need an image info factory arg ";
31             ref $image_info_factory and $image_info_factory->isa('App::MaMGal::ImageInfoFactory') or croak "Arg is not an App::MaMGal::ImageInfoFactory, but a [$image_info_factory]";
32             my $logger = shift or croak "Need a logger arg ";
33             ref $logger and $logger->isa('App::MaMGal::Logger') or croak "Arg is not a App::MaMGal::Logger , but a [$logger]";
34             $self->{formatter} = $formatter;
35             $self->{mplayer_wrapper} = $mplayer_wrapper;
36             $self->{image_info_factory} = $image_info_factory;
37             $self->{logger} = $logger;
38             }
39              
40             sub sounds_like_picture($)
41             {
42             my $base_name = shift;
43             return $base_name =~ /\.(jpe?g|gif|png|tiff?|bmp)$/io;
44             }
45              
46             sub sounds_like_film($)
47             {
48             my $base_name = shift;
49             return $base_name =~ /\.(mpe?g|mov|avi|mjpeg|m[12]v|wmv|fli|nuv|vob|ogm|vcd|svcd|mp4|qt|ogg)$/io;
50             }
51              
52             sub canonicalize_path($)
53             {
54             croak "List context required" unless wantarray;
55              
56             my $path = shift;
57              
58             # Do some path mangling in two special cases:
59             if ($path eq '.') {
60             # discover current directory name, so that it looks nice in
61             # listings, and we know where to ascend when retracting towards
62             # root directory
63             $path = Cwd::abs_path($path);
64             } elsif ($path eq '/') {
65             # mangle the path so that the following regular expression
66             # splits it nicely
67             $path = '//.';
68             }
69              
70             # Split the path into containing directory and basename, stripping any trailing slashes
71             $path =~ m{^(.*?)/?([^/]+)/*$}o or confess sprintf(gettext("Internal Error: [%s] does not end with a base name."), $path);
72             my ($dirname, $basename) = ($1 || '.', $2);
73             return ($path, $dirname, $basename);
74             }
75              
76              
77             sub create_entry_for
78             {
79             my $self = shift;
80             my $path_arg = shift or croak "Need path"; # absolute, or relative to CWD
81             croak "Need 1 arg, got more: [$_[0]]" if @_;
82              
83             my ($path, $dirname, $basename) = canonicalize_path($path_arg);
84             my $lstat = lstat($path) or App::MaMGal::SystemException->throw(message => '%s: getting status failed: %s', objects => [$path, $!]);
85             my $stat = $lstat;
86             if ($lstat->mode & S_IFLNK) {
87             $stat = stat($path);
88             }
89              
90             my $e;
91             if (not $stat) {
92             $e = App::MaMGal::Entry::BrokenSymlink->new($dirname, $basename, $lstat)
93              
94             } elsif ($stat->mode & S_IFDIR) {
95             $e = App::MaMGal::Entry::Dir->new($dirname, $basename, $stat)
96              
97             } elsif (($stat->mode & S_IFREG) and sounds_like_picture($path)) {
98             $e = App::MaMGal::Entry::Picture::Static->new($dirname, $basename, $stat)
99              
100             } elsif (($stat->mode & S_IFREG) and sounds_like_film($path)) {
101             $e = App::MaMGal::Entry::Picture::Film->new($dirname, $basename, $stat)
102              
103             } else {
104             $e = App::MaMGal::Entry::NonPicture->new($dirname, $basename, $stat)
105             }
106             $e->add_tools({ entry_factory => $self, map { $_ => $self->{$_} } qw(formatter mplayer_wrapper image_info_factory logger) });
107             return $e;
108             }
109              
110             1;