lib/App/Gallery.pm

   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
  15 our $VERSION = '0.001001';
  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