projects / app-gallery.git / blame
| Commit | Line | Data |
|---|---|---|
| b1336dac MG |
1 | package App::Gallery; |
| 2 | ||
| 3 | use 5.014000; | |
| 4 | use strict; | |
| 5 | use warnings; | |
| 6 | ||
| 7 | use File::Basename qw/fileparse/; | |
| 8 | use File::Copy qw/cp/; | |
| 9 | use File::Path qw/make_path/; | |
| 10 | use File::Slurp; | |
| 11 | use File::Spec::Functions qw/catdir catfile/; | |
| 12 | use HTML::Template::Compiled; | |
| 13 | use Image::Magick; | |
| 14 | ||
| 1bd9c471 | 15 | our $VERSION = '0.001001'; |
| b1336dac MG |
16 | |
| 17 | my $default_template; | |
| 18 | my %default_args = (tmpl => '', title => 'Gallery', width => 600, height => 600); | |
| 19 | ||
| 20 | sub run { | |
| 21 | my (undef, $args, @images) = @_; | |
| 22 | my %args = (%default_args, %$args); | |
| 23 | my $full = catfile $args{out}, 'full'; | |
| 24 | my $thumb = catfile $args{out}, 'thumb'; | |
| 25 | my $tmpl = HTML::Template::Compiled->new( | |
| 26 | (($args{tmpl} // '') eq '') | |
| 27 | ? (scalarref => \$default_template) | |
| 28 | : (filename => $args{tmpl}), | |
| 29 | default_escape => 'HTML', | |
| 30 | ); | |
| 31 | make_path $full, $thumb; | |
| 32 | ||
| 33 | for my $path (@images) { | |
| 34 | my $basename = fileparse $path; | |
| 35 | my $thumb_path = catfile $thumb, $basename; | |
| 36 | my $dest_path = catfile $full, $basename; | |
| 37 | ||
| 38 | link $path, $dest_path or cp $path, $dest_path or die "$!"; | |
| 39 | ||
| 40 | my $img = Image::Magick->new; | |
| 41 | $img->Read($path); | |
| 42 | my ($width, $height) = $img->Get('width', 'height'); | |
| 43 | my $aspect_ratio = $width / $height; | |
| 44 | if ($width > $args{width}) { | |
| 45 | $width = $args{width}; | |
| 46 | $height = $width / $aspect_ratio; | |
| 47 | } | |
| 48 | if ($height > $args{height}) { | |
| 49 | $height = $args{height}; | |
| 50 | $width = $height * $aspect_ratio; | |
| 51 | } | |
| 52 | $img->Thumbnail(width => $width, height => $height); | |
| 53 | $img->Write($thumb_path); | |
| 54 | } | |
| 55 | ||
| 56 | $tmpl->param( | |
| 57 | title => $args{title}, | |
| 58 | images => [map { scalar fileparse $_ } @images] | |
| 59 | ); | |
| 60 | ||
| 61 | my $index = catfile $args{out}, 'index.html'; | |
| 62 | write_file $index, $tmpl->output; | |
| 63 | } | |
| 64 | ||
| 65 | $default_template = <<'EOF'; | |
| 66 | <!DOCTYPE html> | |
| 67 | <title><tmpl_var title></title> | |
| 68 | <meta charset="utf-8"> | |
| 69 | <style> | |
| 70 | .imgwrap { | |
| 71 | display: inline-block; | |
| 72 | margin: 6px 3px; | |
| 73 | vertical-align: center; | |
| 74 | text-align: center; | |
| 75 | } | |
| 76 | </style> | |
| 77 | <link rel="stylesheet" href="style.css"> | |
| 78 | ||
| 79 | <h1><tmpl_var title></h1> | |
| 80 | <div> | |
| 81 | <tmpl_loop images><div class=imgwrap><a href='full/<tmpl_var _>'><img src='thumb/<tmpl_var _>'></a></div> | |
| 82 | </tmpl_loop></div> | |
| 83 | EOF | |
| 84 | ||
| 85 | 1; | |
| 86 | __END__ | |
| 87 | ||
| 88 | =encoding utf-8 | |
| 89 | ||
| 90 | =head1 NAME | |
| 91 | ||
| 92 | App::Gallery - Very basic picture gallery | |
| 93 | ||
| 94 | =head1 SYNOPSIS | |
| 95 | ||
| 96 | use App::Gallery; | |
| 97 | ||
| 98 | =head1 DESCRIPTION | |
| 99 | ||
| 100 | App::Gallery is a script for creating a very basic picture gallery out | |
| 101 | of a list of pictures. | |
| 102 | ||
| 103 | =head1 SEE ALSO | |
| 104 | ||
| 105 | =head1 AUTHOR | |
| 106 | ||
| 107 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> | |
| 108 | ||
| 109 | =head1 COPYRIGHT AND LICENSE | |
| 110 | ||
| 111 | Copyright (C) 2017 by Marius Gavrilescu | |
| 112 | ||
| 113 | This library is free software; you can redistribute it and/or modify | |
| 114 | it under the same terms as Perl itself, either Perl version 5.24.2 or, | |
| 115 | at your option, any later version of Perl 5 you may have available. | |
| 116 | ||
| 117 | ||
| 118 | =cut |