File Coverage

blib/lib/Alien/Lightbox.pm
Criterion Covered Total %
statement 56 57 98.2
branch 6 8 75.0
condition n/a
subroutine 14 15 93.3
pod 5 5 100.0
total 81 85 95.2


line stmt bran cond sub pod time code
1             package Alien::Lightbox;
2              
3             ###############################################################################
4             # Required inclusions.
5             ###############################################################################
6 2     2   140641 use strict;
  2         14  
  2         56  
7 2     2   9 use warnings;
  2         4  
  2         47  
8 2     2   11 use Carp;
  2         2  
  2         152  
9 2     2   12 use File::Spec;
  2         4  
  2         44  
10 2     2   1085 use File::Copy qw(copy);
  2         8883  
  2         141  
11 2     2   15 use File::Path qw(mkpath);
  2         3  
  2         128  
12 2     2   14 use File::Find qw(find);
  2         3  
  2         145  
13 2     2   15 use File::Basename qw(basename dirname);
  2         4  
  2         189  
14 2     2   1133 use Alien::scriptaculous;
  2         3702  
  2         1004  
15              
16             ###############################################################################
17             # Version number
18             ###############################################################################
19             our $LIGHTBOX_VERSION = '2.03.3';
20             our $VERSION = '2.03.3.4';
21              
22             ###############################################################################
23             # Subroutine: version()
24             ###############################################################################
25             # Returns the Lightbox version number.
26             #
27             # Not to be confused with the 'Alien::Lightbox' version number (which is the
28             # version number of the Perl wrapper).
29             ###############################################################################
30             sub version {
31 0     0 1 0 return $LIGHTBOX_VERSION;
32             }
33              
34             ###############################################################################
35             # Subroutine: path()
36             ###############################################################################
37             # Returns the path to the available copy of Lightbox.
38             ###############################################################################
39             sub path {
40 3     3 1 11 my $base = $INC{'Alien/Lightbox.pm'};
41 3         22 $base =~ s{\.pm$}{};
42 3         11 return $base;
43             }
44              
45             ###############################################################################
46             # Subroutine: to_blib()
47             ###############################################################################
48             # Returns a hash containing paths to the source files to be copied, and their
49             # relative destinations.
50             ###############################################################################
51             sub to_blib {
52 3     3 1 11 my $class = shift;
53 3         13 my $path = $class->path();
54 3         22 my %blib;
55              
56             # JS/CSS files
57 3         11 my @files = qw(js/lightbox.js css/lightbox.css);
58 3         11 foreach my $file (@files) {
59 6         74 my $src = File::Spec->catfile( $path, $file );
60 6         208 $blib{$src} = basename($file);
61             }
62              
63             # images
64 3         22 my $imagedir = File::Spec->catdir( $path, 'images' );
65             File::Find::find(
66             sub {
67 33 100   33   783 -f $_ && do {
68 30         90 my $dstdir = $File::Find::dir;
69 30         195 $dstdir =~ s{^$imagedir/?}{};
70 30         444 $blib{$File::Find::name} = File::Spec->catfile('lightbox', $dstdir, $_);
71             }
72             },
73 3         437 $imagedir
74             );
75              
76             # return list of files to install
77 3         54 return %blib;
78             }
79              
80             ###############################################################################
81             # Subroutine: files()
82             ###############################################################################
83             # Returns the list of files that are installed by Alien::Lightbox.
84             ###############################################################################
85             sub files {
86 1     1 1 97 my $class = shift;
87 1         6 my %blib = $class->to_blib();
88 1         17 return sort values %blib;
89             }
90              
91             ###############################################################################
92             # Subroutine: install($destdir)
93             # Parameters: $destdir - Destination directory
94             ###############################################################################
95             # Installs the Lightbox into the given '$destdir'. Throws a fatal exception on
96             # errors.
97             ###############################################################################
98             sub install {
99 2     2 1 5709 my ($class, $destdir) = @_;
100              
101             # install scriptaculous
102 2         18 Alien::scriptaculous->install( $destdir );
103              
104             # install our files
105 2         7473 my %blib = $class->to_blib();
106 2         16 while (my ($srcfile, $dest) = each %blib) {
107             # get full path to destination file
108 24         7372 my $destfile = File::Spec->catfile( $destdir, $dest );
109             # create any required install directories
110 24         678 my $instdir = dirname( $destfile );
111 24 100       429 if (!-d $instdir) {
112 1 50       154 mkpath( $instdir ) || croak "can't create '$instdir'; $!";
113             }
114             # install the file
115 24 50       107 copy( $srcfile, $destfile ) || croak "can't copy '$srcfile' to '$instdir'; $!";
116             }
117             }
118              
119             1;
120              
121             =head1 NAME
122              
123             Alien::Lightbox - (DEPRECATED) installing and finding Lightbox JS
124              
125             =head1 SYNOPSIS
126              
127             use Alien::Lightbox;
128             ...
129             $version = Alien::Lightbox->version();
130             $path = Alien::Lightbox->path();
131             ...
132             Alien::Lightbox->install( $my_destination_directory );
133              
134             =head1 DESCRIPTION
135              
136             B - DO NOT USE.
137              
138             Please see L for the manifesto of the Alien namespace.
139              
140             =head1 METHODS
141              
142             =over
143              
144             =item version()
145              
146             Returns the Lightbox version number.
147              
148             Not to be confused with the C version number (which is the
149             version number of the Perl wrapper).
150              
151             =item path()
152              
153             Returns the path to the available copy of Lightbox.
154              
155             =item to_blib()
156              
157             Returns a hash containing paths to the source files to be copied, and their
158             relative destinations.
159              
160             =item files()
161              
162             Returns the list of files that are installed by Alien::Lightbox.
163              
164             =item install($destdir)
165              
166             Installs the Lightbox into the given C<$destdir>. Throws a fatal exception
167             on errors.
168              
169             =back
170              
171             =head1 AUTHOR
172              
173             Graham TerMarsch (cpan@howlingfrog.com)
174              
175             =head1 LICENSE
176              
177             Copyright (C) 2007, Graham TerMarsch. All rights reserved.
178              
179             This is free software; you can redistribute it and/or modify it under the same terms as Perl itself.
180              
181             =head1 SEE ALSO
182              
183             http://www.huddletogether.com/projects/lightbox2/,
184             L,
185             L.
186              
187             =cut