File Coverage

blib/lib/Labyrinth/Media.pm
Criterion Covered Total %
statement 43 45 95.5
branch n/a
condition n/a
subroutine 15 15 100.0
pod n/a
total 58 60 96.6


line stmt bran cond sub pod time code
1             package Labyrinth::Media;
2              
3 2     2   9337 use warnings;
  2         2  
  2         62  
4 2     2   9 use strict;
  2         7  
  2         51  
5              
6 2     2   6 use vars qw($VERSION @ISA %EXPORT_TAGS @EXPORT @EXPORT_OK);
  2         3  
  2         199  
7             $VERSION = '5.32';
8              
9             =head1 NAME
10              
11             Labyrinth::Media - Media File Management for Labyrinth
12              
13             =head1 DESCRIPTION
14              
15             This module collates many media and image file handling functionality used
16             within Labyrinth.
17              
18             It should be noted that internally images and media files are stored in the
19             same, although images also record dimensions. When retrieving the required
20             files, it is recommend you call the appropriate method to ensure you are
21             getting the correct format of data for the file format. For example, GetImage
22             and GetMedia, both return file information, but GetImage adds deminsion data.
23              
24             Also note that Images and Photos differ in the directory structure storage, so
25             saving and copying need to reference different functions. See below for a more
26             detailed explanation.
27              
28             =cut
29              
30             # -------------------------------------
31             # Export Details
32              
33             require Exporter;
34             @ISA = qw(Exporter);
35              
36             %EXPORT_TAGS = (
37             'all' => [ qw(
38             CGIFile
39             StockSelect StockName StockPath StockType PathMove
40             GetImage SaveImageFile MirrorImageFile
41             CopyPhotoFile SavePhotoFile
42             GetMedia SaveMediaFile SaveFile DeleteFile UnZipFile
43             GetImageSize ResizeDimensions GetGravatar
44             ) ]
45             );
46              
47             @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );
48             @EXPORT = ( @{ $EXPORT_TAGS{'all'} } );
49              
50             # -------------------------------------
51             # Library Modules
52              
53 2     2   991 use Archive::Extract;
  2         228443  
  2         85  
54 2     2   90 use Data::Dumper;
  2         4  
  2         150  
55 2     2   11 use Digest::MD5 qw(md5_hex);
  2         3  
  2         103  
56 2     2   10 use File::Basename;
  2         3  
  2         107  
57 2     2   1071 use File::Copy;
  2         4248  
  2         116  
58 2     2   13 use File::Path;
  2         3  
  2         93  
59 2     2   1236 use File::Slurp;
  2         6942  
  2         103  
60 2     2   1010 use Image::Size;
  2         6616  
  2         106  
61 2     2   544 use URI::Escape qw(uri_escape);
  2         1201  
  2         109  
62 2     2   1558 use WWW::Mechanize;
  2         162523  
  2         86  
63              
64 2     2   17 use Labyrinth::Audit;
  2         2  
  2         299  
65 2     2   116 use Labyrinth::Globals;
  0            
  0            
66             use Labyrinth::DBUtils;
67             use Labyrinth::DIUtils;
68             use Labyrinth::Metadata;
69             use Labyrinth::MLUtils;
70             use Labyrinth::Plugins;
71             use Labyrinth::Support;
72             use Labyrinth::Users;
73             use Labyrinth::Variables;
74              
75             # -------------------------------------
76             # Constants
77              
78             use constant MaxDefaultImageWidth => 800;
79             use constant MaxDefaultImageHeight => 600;
80             use constant MaxDefaultThumbWidth => 200;
81             use constant MaxDefaultThumbHeight => 200;
82              
83             # -------------------------------------
84             # Variables
85              
86             { # START Stock Control
87              
88             my @CHARS = (
89             qw/A B C D E F G H I J K L M N O P Q R S T U V W X Y Z
90             a b c d e f g h i j k l m n o p q r s t u v w x y z
91             0 1 2 3 4 5 6 7 8 9 _
92             /);
93              
94             my %stock;
95              
96             # -------------------------------------
97             # The Functions
98              
99             =head1 PUBLIC INTERFACE FUNCTIONS
100              
101             =head2 Stock Control Functions
102              
103             =over
104              
105             =item CGIFile
106              
107             When uploading a file via a web form, this function will save the file to the
108             local filesystem.
109              
110             =back
111              
112             =cut
113              
114             my %image_store;
115              
116             sub CGIFile {
117             my $param = shift;
118             my $stock = shift || 1;
119              
120             _init_stock() unless(%stock);
121             $stock = 1 unless($stock{$stock});
122             my $path = "$settings{webdir}/$stock{$stock}->{path}";
123             mkpath($path);
124              
125             # have we already saved the file
126             if($image_store{$param}) {
127             # move file if different stock type requested
128             if($image_store{$param}[3] != $stock) {
129             my $source = "$settings{webdir}/$image_store{$param}[1]";
130             my $target = "$path/$image_store{$param}[0].$image_store{$param}[2]";
131             copy($source,$target);
132             #unlink($source);
133              
134             $target =~ s!^$settings{webdir}/!!;
135             $image_store{$param}[1] = $target;
136             $image_store{$param}[3] = $stock;
137             }
138            
139             #LogDebug("CGIFile: return previous $param image_store=".Dumper($image_store{$param}));
140             return @{$image_store{$param}};
141             }
142              
143             my $fn = $cgi->param($param);
144             LogDebug("CGIFile: $param fn=$fn");
145             return unless($fn);
146              
147             my ($bytes,$filename,$dir,$name,$suffix);
148              
149             eval {
150             my $f = $cgi->upload($param) || die "Cannot access filehandle\n";
151             ($name, $dir, $suffix) = fileparse($fn,qr/\.[^.]*/);
152             #LogDebug("CGIFile: fileparse dir=$dir, name=$name, suffix=$suffix");
153              
154             my $tries = 0;
155             while(1) {
156             last if($tries++ > 10);
157             $filename = "$path/" . _randname('imgXXXXXX') . lc($suffix);
158             next if(-f $filename);
159             last;
160             }
161              
162             my $buffer = read_file($f, binmode => ':raw');
163             $bytes = length($buffer);
164             write_file($filename, { binmode => ':raw' }, $buffer);
165             };
166              
167             die $@ if $@;
168              
169             if($bytes == 0) {
170             LogError("CGIFile: no bytes read for input file [$param]");
171             return;
172             }
173              
174             $filename =~ s!^$settings{webdir}/!!;
175             $image_store{$param} = [$name,$filename,$suffix,$stock];
176             #LogDebug("CGIFile: returning $param image_store=".Dumper($image_store{$param}));
177             return ($name,$filename,$suffix);
178             }
179              
180             =head2 Stock Control Functions
181              
182             The stock list relates to the directory paths where uploaded files should be
183             saved on the local filesystem.
184              
185             =over
186              
187             =item StockName
188              
189             Return the name for the given stock id.
190              
191             =item StockPath
192              
193             Return the path for the given stock id.
194              
195             =item StockType
196              
197             Return the stock id for the given stock code.
198              
199             =item StockSelect
200              
201             Returns an XHTML snippet for a dropdown selection box of stock entries.
202              
203             =item PathMove
204              
205             =back
206              
207             =cut
208              
209             sub StockName {
210             my $stock = shift || 1;
211             _init_stock() unless(%stock);
212             return $stock{$stock}->{title};
213             }
214              
215             sub StockPath {
216             my $stock = shift || 1;
217             _init_stock() unless(%stock);
218             return $stock{$stock}->{path};
219             }
220              
221             sub StockType {
222             my $stock = shift || 'DRAFT';
223             _init_stock() unless(%stock);
224             for(keys %stock) {
225             return $_ if($stock{$_}->{title} eq $stock);
226             }
227             return 1; # default
228             }
229              
230             sub StockSelect {
231             my $opt = shift || 0;
232             my $blank = shift || 1;
233             _init_stock() unless(%stock);
234              
235             my $html = "
236             $html .= "" if(defined $blank && $blank == 1);
237              
238             foreach (sort {$a <=> $b} keys %stock) {
239             $html .= "
240             $html .= ' selected="selected"' if($opt == $_);
241             $html .= ">$stock{$_}->{title}";
242             }
243             $html .= "";
244              
245             return $html;
246             }
247              
248             sub PathMove {
249             my ($stockid,$link) = @_;
250             my ($path,$name) = ($link =~ m!(.+)/([^/]+)!);
251             return $link if($stock{$stockid}->{path} eq $path);
252              
253             my $old = "$settings{webdir}/$link";
254             my $new = "$settings{webdir}/$stock{$stockid}->{path}/$name";
255              
256             rename $old, $new;
257             return "$stock{$stockid}->{path}/$name";
258             }
259              
260             # -------------------------------------
261             # Private Functions
262              
263             sub _init_stock {
264             my @rows = $dbi->GetQuery('hash','AllImageStock');
265             $stock{$_->{stockid}} = $_ for(@rows);
266             }
267              
268             sub _randname {
269             my $path = shift;
270             $path =~ s/X(?=X*\z)/$CHARS[ int( rand( $#CHARS ) ) ]/ge;
271             return $path;
272             }
273              
274             } # END Stock Control
275              
276             # -------------------------------------
277             # Public Image Functions
278              
279             =head2 Image Functions
280              
281             =over 4
282              
283             =item GetImage($imageid)
284              
285             Retrieves the image data for a given imageid.
286              
287             =item SaveImageFile(%hash)
288              
289             Saves an uploaded image file into the specified directory structure. If not
290             save directory is specified, the draft folder is used. The hash can contain
291             the following:
292              
293             param - the CGI parameter used to reference the upload file
294             width - maximum saved width (default = 120px)
295             height - maximum saved height (default = 120px)
296             imageid - if overwriting already existing file
297             stock - file category (used to define the save directory)
298              
299             =item MirrorImageFile($source,$stock [,$xmax,$ymax] )
300              
301             Mirrors a file from a URL to the local file system. If a max width and height
302             are given, will resize the image.
303              
304             =item GetImageSize($link,$size,$width,$height,$maxwidth,$maxheight)
305              
306             For a given file, returns the true width and height that will be rendered
307             within the browser, given the current and default settings.
308              
309             =item ResizeDimensions($dimensions,$file,$maxwidth,$maxheight)
310              
311             Given the current dimensions, file and intended max height and width, will
312             return the width and height values to use in a image tag to scale the
313             dimensions to the require box size.
314              
315             =item GetGravatar
316              
317             Returns a Gravatar link.
318              
319             =back
320              
321             =cut
322              
323             sub GetImage {
324             my $imageid = shift;
325             my @rows = $dbi->GetQuery('hash','GetImageByID',$imageid);
326             return() unless(@rows);
327              
328             my ($x,$y);
329             if($rows[0]->{dimensions}) {
330             ($x,$y) = split("x",$rows[0]->{dimensions});
331             } else {
332             ($x,$y) = imgsize($settings{webdir}.'/'.$rows[0]->{link});
333             }
334             return($rows[0]->{tag},$rows[0]->{link},$rows[0]->{href},$x,$y);
335             }
336              
337              
338             # stock type DRAFT should always be id 1
339             # DRAFT images are removed during reaping
340              
341             sub MirrorImageFile {
342             my ($source,$stock,$xmax,$ymax) = @_;
343             my $stockid = StockType($stock);
344              
345             my $name = basename($source);
346             my $file = StockPath($stockid) . '/' . $name;
347             my $target = $settings{'webdir'} . '/' . $file;
348              
349             my $mechanize = WWW::Mechanize->new();
350             $mechanize->mirror( $source, $target );
351              
352             if($xmax && $ymax) {
353             my $i = Labyrinth::DIUtils->new($target);
354             $i->reduce($xmax,$ymax);
355             }
356              
357             my ($size_x,$size_y) = imgsize($target);
358              
359             my $imageid = SaveImage(
360             undef,
361             $name, # tag (maybe keywords)
362             $file, # filename
363             $stockid, # stock type
364             undef,
365             $size_x . 'x' . $size_y
366             );
367              
368             return ($imageid,$file);
369             }
370              
371             sub SaveImageFile {
372             my %hash = @_;
373              
374             my $param = $hash{param};
375             my $xmax = $hash{width} || $settings{maxdefaultimagewidth} || MaxDefaultImageWidth;
376             my $ymax = $hash{height} || $settings{maxdefaultimageheight} || MaxDefaultImageHeight;
377             my $imageid = $hash{imageid};
378             my $stock = StockType($hash{stock});
379              
380             return unless($param && $cgiparams{$param});
381              
382             my ($name,$filename) = CGIFile($param,$stock);
383             return 1 unless($name); # blank if anything goes wrong
384              
385             eval {
386             LogDebug("reducing '$settings{webdir}/$filename' to $xmax x $ymax");
387             my $i = Labyrinth::DIUtils->new("$settings{webdir}/$filename");
388             $i->reduce($xmax,$ymax);
389             };
390              
391             LogDebug("error reducing '$settings{webdir}/$filename': $@") if($@);
392              
393             my ($size_x,$size_y) = imgsize("$settings{webdir}/$filename");
394              
395             $imageid = SaveImage(
396             $imageid,
397             $name, # tag (maybe keywords)
398             $filename, # filename
399             $stock, # stock type
400             $hash{href},
401             $size_x . 'x' . $size_y
402             );
403              
404             return ($imageid,$filename);
405             }
406              
407             sub GetImageSize {
408             my ($link,$size,$width,$height,$maxwidth,$maxheight) = @_;
409             $maxwidth ||= $settings{maxdefaultimagewidth} || MaxDefaultImageWidth;
410             $maxheight ||= $settings{maxdefaultimageheight} || MaxDefaultImageHeight;
411              
412             my ($w,$h) = $size ? split('x',$size) : (0,0);
413             ($w,$h) = imgsize("$settings{webdir}/$link") unless($w || $h);
414              
415             ($width,$height) = ($w,$h) unless($width || $height);
416              
417             # long winded to avoid uninitialised variable errors
418             if(defined $width && defined $height && $width > $height && $width > $maxwidth) {
419             $width = $maxwidth;
420             $height = 0;
421             } elsif(defined $width && defined $height && $width < $height && $height > $maxheight) {
422             $height = $maxheight;
423             $width = 0;
424             } elsif(defined $width && $width > $maxwidth) {
425             $width = $maxwidth;
426             $height = 0;
427             } elsif(defined $height && $height > $maxheight) {
428             $height = $maxheight;
429             $width = 0;
430             }
431              
432             if($width && $height) {
433             # nothing
434             } elsif( $width && !$height) {
435             $height = int($h * ($width / $w));
436             } elsif(!$width && $height) {
437             $width = int($w * ($height / $h));
438             }
439              
440             #LogDebug("dimensions: x.($w,$h) / ($width,$height) / ($settings{webdir}/$link)");
441              
442             return ($width,$height);
443             }
444              
445             sub ResizeDimensions {
446             my ($dimensions,$file,$maxwidth,$maxheight) = @_;
447             my $toobig = 0;
448             my ($x,$y);
449              
450             if($tvars{data}->{dimensions}) {
451             ($x,$y) = split("x",$tvars{data}->{dimensions});
452             } else {
453             ($x,$y) = imgsize($file) if(-f $file);
454             }
455              
456             return unless($x && $y);
457             return ($x,$y,$toobig) unless($maxwidth && $maxheight);
458             return ($x,$y,$toobig) if($x <= $maxwidth && $y <= $maxheight);
459              
460             $toobig = 1;
461             my $xr = $maxwidth ? $maxwidth / $x : 0;
462             my $yr = $maxheight ? $maxheight / $y : 0;
463              
464             if($xr <= $yr) {
465             $x *= $xr;
466             $y *= $xr;
467             } else {
468             $x *= $yr;
469             $y *= $yr;
470             }
471              
472             return (int($x),int($y),$toobig);
473             }
474              
475             sub GetGravatar {
476             my ($id,$email) = @_;
477             my $nophoto = uri_escape($settings{nophoto});
478              
479             return $nophoto unless($id);
480             my $user = GetUser($id);
481             return $nophoto unless($user);
482              
483             return
484             'http://www.gravatar.com/avatar.php?'
485             .'gravatar_id='.md5_hex($email)
486             .'&default='.$nophoto
487             .'&size=80';
488             }
489              
490             =head2 Image Functions
491              
492             =over 4
493              
494             =item CopyPhotoFile()
495              
496             Copy an existing stored image, both on the filesystem and in the database.
497              
498             =item SavePhotoFile()
499              
500             Save a photo uploaded via a web form to the local filesystem and to the photo
501             gallery database table.
502              
503             =back
504              
505             =cut
506              
507             sub CopyPhotoFile {
508             my %hash = @_;
509              
510             my $photo = $hash{photo};
511             my $xmax = $hash{width} || $settings{maxdefaultimagewidth} || MaxDefaultImageWidth;
512             my $ymax = $hash{height} || $settings{maxdefaultimageheight} || MaxDefaultImageHeight;
513             my $stock = StockType($hash{stock});
514              
515             return unless($photo);
516              
517             my @rs = $dbi->GetQuery('hash','GetPhotoDetail',$photo);
518             my $name = basename($rs[0]->{image});
519             return 1 unless($name); # blank if anything goes wrong
520              
521             my $source = "$settings{webdir}/photos/$rs[0]->{image}";
522             my $target = "$settings{webdir}/images/draft/$name";
523             copy($source,$target);
524              
525             my $i = Labyrinth::DIUtils->new($target);
526             $i->reduce($xmax,$ymax);
527              
528             my ($size_x,$size_y) = imgsize($target);
529              
530             $target =~ s!$settings{webdir}/!!;
531              
532             my $imageid = SaveImage(
533             undef,
534             $name, # tag (maybe keywords)
535             $target, # filename
536             $stock, # stock type
537             $hash{href},
538             $size_x . 'x' . $size_y
539             );
540              
541             return ($imageid,$target);
542             }
543              
544             sub SavePhotoFile {
545             my %hash = @_;
546              
547             my $param = $hash{param} || return;
548             my $path = $hash{path} || return;
549             my $page = $hash{page} || return;
550             my $iwidth = $hash{iwidth} || $settings{maxdefaultimagewidth} || MaxDefaultImageWidth;
551             my $iheight = $hash{iheight} || $settings{maxdefaultimageheight} || MaxDefaultImageHeight;
552             my $twidth = $hash{twidth} || $settings{maxdefaultthumbwidth} || MaxDefaultThumbWidth;
553             my $theight = $hash{theight} || $settings{maxdefaultthumbheight} || MaxDefaultThumbHeight;
554             my $order = $hash{order} || 1;
555             my $tag = $hash{tag};
556             my $stock = StockType($hash{stock});
557              
558             return unless($cgiparams{$param});
559              
560             my ($name,$filename,$extn) = CGIFile($param,$stock);
561             return 1 unless($name); # blank if anything goes wrong
562             $tag = $name unless(defined $tag);
563              
564             my $file = lc($name);
565             $file =~ s/\s+//g;
566              
567             my $source = "$settings{webdir}/$filename";
568             my $target = "$settings{webdir}/$path/$file$extn";
569             copy($source,$target);
570              
571             $source = "$settings{webdir}/$path/$file$extn";
572             $target = "$settings{webdir}/$path/$file-thumb$extn";
573             copy($source,$target);
574              
575             eval {
576             LogDebug("reducing '$source' to $iwidth x $iheight");
577             my $i = Labyrinth::DIUtils->new($source);
578             $i->reduce($iwidth,$iheight);
579             };
580             eval {
581             LogDebug("reducing '$target' to $twidth x $theight");
582             my $t = Labyrinth::DIUtils->new($target);
583             $t->reduce($twidth,$theight);
584             };
585              
586             my ($size_x,$size_y) = imgsize($source);
587              
588             $source =~ s!$settings{webdir}/(photos/)?!!;
589             $target =~ s!$settings{webdir}/(photos/)?!!;
590             my $photoid = $dbi->IDQuery('SavePhoto',$page,$target,$source,$size_x.'x'.$size_y,$tag,$order);
591              
592             MetaSave($photoid,['Photo'],split(/[ ,]+/,$name));
593              
594             return ($photoid,$name);
595             }
596              
597             =head2 Media Functions
598              
599             =over 4
600              
601             =item GetMedia($imageid)
602              
603             Retrieves the media data for a given imageid.
604              
605             =item SaveMediaFile(%hash)
606              
607             Saves an uploaded media file into the specified directory structure. If no
608             save directory is specified, the draft folder is used. The hash can contain
609             the following:
610              
611             param - the CGI parameter used to reference the upload file
612             imageid - if overwriting already existing file
613             stock - file category (used to define the save directory)
614              
615             =back
616              
617             =cut
618              
619             sub GetMedia {
620             my $imageid = shift;
621             my @rows = $dbi->GetQuery('hash','GetImageByID',$imageid);
622             return() unless(@rows);
623             return($rows[0]->{tag},$rows[0]->{link},$rows[0]->{href});
624             }
625              
626              
627             # stock type DRAFT should always be id 1
628             # DRAFT images are removed during reaping
629              
630             sub SaveMediaFile {
631             my %hash = @_;
632              
633             my $param = $hash{param};
634             my $imageid = $hash{imageid};
635             my $stock = StockType($hash{stock});
636              
637             return unless($param && $cgiparams{$param});
638              
639             my ($name,$filename) = CGIFile($param,$stock);
640             return 1 unless($name); # blank if anything goes wrong
641              
642             $imageid = SaveImage(
643             $imageid,
644             $name, # tag (maybe keywords)
645             $filename, # filename
646             $stock, # stock type
647             $hash{href},
648             ''
649             );
650              
651             return ($imageid,$filename);
652             }
653              
654             =over
655              
656             =item SaveFile(%hash)
657              
658             Saves an uploaded media file into the specified directory structure. If no
659             save directory is specified, the draft folder is used. The hash can contain
660             the following:
661              
662             param - the CGI parameter used to reference the upload file
663             stock - file category (used to define the save directory)
664              
665             Note that this upload function assumes that the file is to be stored in the
666             appropriate directory with a link being return. No imageid or further reference
667             is held within the database.
668              
669             =cut
670              
671             sub SaveFile {
672             my %hash = @_;
673              
674             my $param = $hash{param};
675             my $stock = StockType($hash{stock});
676              
677             return unless($param && $cgiparams{$param});
678              
679             my ($name,$filename) = CGIFile($param,$stock,1);
680             return unless($name); # undef if anything goes wrong
681              
682             return $filename;
683             }
684              
685             =item DeleteFile(%hash)
686              
687             Deletes a previously uploaded media file from disk. No attempt is made to check
688             whether file is used within the database, other checks should be used prior to
689             calling this function if this is required. The hash can contain the following:
690              
691             file - file to be deleted
692              
693             =back
694              
695             =cut
696              
697             sub DeleteFile {
698             my %hash = @_;
699              
700             my $file = $hash{file};
701             unlink $file;
702             }
703              
704             =head1 ADMIN INTERFACE FUNCTIONS
705              
706             =over 4
707              
708             =item ImageCheck
709              
710             Used by Images::Delete to verify whether a particular module uses a particular
711             image referenced in the database.
712              
713             =back
714              
715             =cut
716              
717             sub ImageCheck {
718             my $imageid = shift;
719              
720             foreach my $plugin (get_plugins) {
721             return 1 if( $plugin->ImageCheck($imageid) );
722             }
723              
724             return 0;
725             }
726              
727             =head1 LOCAL INTERNAL FUNCTIONS
728              
729             =over 4
730              
731             =item SaveImage
732              
733             Writes image data to the database.
734              
735             =cut
736              
737             sub SaveImage {
738             my ($imageid,@fields) = @_;
739              
740             if($imageid) { $dbi->DoQuery('SaveImage',@fields,$imageid); }
741             else { $imageid = $dbi->IDQuery('AddImage',@fields); }
742              
743             return $imageid;
744             }
745              
746             =item UnZipFile
747              
748             Un wraps an archive file and stores it in an appropriate directory. For a
749             single file archive, the path to the file is returned. For collecions of
750             files, an 'index.html' is searched for and the path to it returned if
751             found. In all other instances the either the path to the first HTML file or
752             first other file is returned.
753              
754             =cut
755              
756             sub UnZipFile {
757             my $file = shift;
758             return unless($file =~ /(.*)\.(zip|tar|tar\.gz|tgz)$/);
759              
760             my $path = $1;
761             return unless($path);
762              
763             # extract in to path directory
764             # note ONLY ONE extraction allowed, in case zip of death uploaded
765              
766             my $ae = Archive::Extract->new( archive => "$settings{webdir}/$file" );
767             my $ok = $ae->extract( to => "$settings{webdir}/$path" );
768             unless($ok) {
769             LogError("UnZip failure: file=[$file], path=[$path], error: ".$ae->error);
770             rmtree("$settings{webdir}/$path");
771             unlink("$settings{webdir}/$file");
772             return;
773             }
774              
775             my @files = map {my $x = $_; $x =~ s!$settings{webdir}/!!; $x} File::Find::Rule->file()->name('*')->in("$settings{webdir}/$path");
776             unless(@files > 0) {
777             LogError("UnZip failure: file=[$file], path=[$path], error: No files in archive.");
778             rmtree("$settings{webdir}/$path");
779             unlink("$settings{webdir}/$file");
780             return;
781             }
782              
783             # return file if count == 1
784             return $files[0] if(@files == 1);
785              
786             # return index.html if found
787             my @html = grep {/^index.html?$/} @files;
788             return $html[0] if(@html);
789              
790             # return first html file if found
791             @html = grep {/\.html?$/} @files;
792             return $html[0] if(@html);
793              
794             # return first file found
795             return $files[0];
796             }
797              
798             1;
799              
800             __END__