lib/App/MusicExpo.pm

   1 package App::MusicExpo;
   2 use 5.014000;
   3 use strict;
   4 use warnings;
   5
   6 our $VERSION = '1.002001';
   7
   8 use HTML::Template::Compiled qw//;
   9 use Memoize qw/memoize/;
  10
  11 use DB_File qw//;
  12 use Encode qw/encode/;
  13 use File::Basename qw/fileparse/;
  14 use Fcntl qw/O_RDWR O_CREAT/;
  15 use Getopt::Long;
  16 use Storable qw/thaw freeze/;
  17 use sort 'stable';
  18
  19 ##################################################
  20
  21 my $default_template;
  22
  23 our $prefix='/music/';
  24 our $cache='';
  25 our $template='';
  26
  27 GetOptions (
  28         'template:s' => \$template,
  29         'prefix:s' => \$prefix,
  30         'cache:s' => \$cache,
  31 );
  32
  33 sub flacinfo{
  34         my $file=$_[0];
  35         my $flac=Audio::FLAC::Header->new($file);
  36
  37         freeze +{
  38                 format => 'FLAC',
  39                 title => $flac->tags('TITLE'),
  40                 artist => $flac->tags('ARTIST'),
  41                 year => $flac->tags('DATE'),
  42                 album => $flac->tags('ALBUM'),
  43                 tracknumber => $flac->tags('TRACKNUMBER'),
  44                 tracktotal => $flac->tags('TRACKTOTAL'),
  45                 genre => $flac->tags('GENRE'),
  46                 file => scalar fileparse $file,
  47         }
  48 }
  49
  50 sub mp3info{
  51         my $file=$_[0];
  52         my %tag = map { encode 'UTF-8', $_ } %{MP3::Info::get_mp3tag $file};
  53         my @trkn = split m#/#s, $tag{TRACKNUM} // '';
  54
  55         freeze +{
  56                 format => 'MP3',
  57                 title => $tag{TITLE},
  58                 artist => $tag{ARTIST},
  59                 year => $tag{YEAR},
  60                 album => $tag{ALBUM},
  61                 tracknumber => $trkn[0],
  62                 tracktotal => $trkn[1],
  63                 genre => $tag{GENRE},
  64                 file => scalar fileparse $file,
  65         }
  66 }
  67
  68 sub vorbisinfo{
  69         my $file=$_[0];
  70         my $ogg=Ogg::Vorbis::Header::PurePerl->new($file);
  71
  72         freeze +{
  73                 format => 'Vorbis',
  74                 title => scalar $ogg->comment('TITLE'),
  75                 artist => scalar $ogg->comment('artist'),
  76                 year => scalar $ogg->comment('DATE'),
  77                 album => scalar $ogg->comment('ALBUM'),
  78                 tracknumber => scalar $ogg->comment('TRACKNUMBER'),
  79                 tracktotal => scalar $ogg->comment('TRACKTOTAL'),
  80                 genre => scalar $ogg->comment('GENRE'),
  81                 file => scalar fileparse $file,
  82         }
  83 }
  84
  85 sub mp4_format ($){ ## no critic (ProhibitSubroutinePrototypes)
  86         my $encoding = $_[0];
  87         return 'AAC' if $encoding eq 'mp4a';
  88         return 'ALAC' if $encoding eq 'alac';
  89         "MP4-$encoding"
  90 }
  91
  92 sub mp4info{
  93         my $file=$_[0];
  94         my %tag = map { ref() ? $_ : encode 'UTF-8', $_ } %{MP4::Info::get_mp4tag $file};
  95         my %info = %{MP4::Info::get_mp4info $file};
  96
  97         freeze +{
  98                 format => mp4_format $info{ENCODING},
  99                 title => $tag{TITLE},
 100                 artist => $tag{ARTIST},
 101                 year => $tag{YEAR},
 102                 album => $tag{ALBUM},
 103                 tracknumber => $tag{TRACKNUM},
 104                 tracktotal => ($tag{TRKN} ? $tag{TRKN}->[1] : undef),
 105                 genre => $tag{GENRE},
 106                 file => scalar fileparse $file,
 107         };
 108 }
 109
 110 sub opusinfo {
 111         my $file = $_[0];
 112         my $of = Audio::Opusfile->new_from_file($file);
 113         my $tags = $of->tags;
 114
 115         my %data = (
 116                 format => 'Opus',
 117                 title => $tags->query('TITLE'),
 118                 artist => $tags->query('ARTIST'),
 119                 year => $tags->query('DATE'),
 120                 album => $tags->query('ALBUM'),
 121                 tracknumber => $tags->query('TRACKNUMBER'),
 122                 tracktotal => $tags->query('TRACKTOTAL'),
 123                 genre => $tags->query('GENRE'),
 124                 file => scalar fileparse $file
 125         );
 126
 127         freeze \%data;
 128 }
 129
 130 my @optional_modules = (
 131         [ 'Audio::FLAC::Header', \&flacinfo, '.flac' ],
 132         [ 'MP3::Info', \&mp3info, '.mp3' ],
 133         [ 'Ogg::Vorbis::Header::PurePerl', \&vorbisinfo, '.ogg', '.oga' ],
 134         [ 'MP4::Info', \&mp4info, '.mp4', '.aac', '.m4a' ],
 135         [ 'Audio::Opusfile', \&opusinfo, '.opus' ]
 136 );
 137
 138 my %info;
 139
 140 for (@optional_modules) {
 141         my ($module, $coderef, @extensions_handled) = @$_;
 142         if (eval "require $module") {
 143                 $info{$_} = $coderef for @extensions_handled
 144         }
 145 }
 146
 147 unless (%info) {
 148         warn 'No tags-reading module detected. Install one of the following modules: ' . join ', ', map { $_->[0] } @optional_modules;
 149 }
 150
 151 sub normalizer{
 152         "$_[0]|".(stat $_[0])[9]
 153 }
 154
 155 sub make_fragment{ join '-', map { lc =~ y/a-z0-9/_/csr } @_ }
 156
 157 sub extensions_handled { keys %info }
 158
 159 sub run {
 160         if ($cache) {
 161                 tie my %cache, 'DB_File', $cache, O_RDWR|O_CREAT, 0644; ## no critic (ProhibitTie)
 162                 $info{$_} = memoize $info{$_}, INSTALL => undef, NORMALIZER => \&normalizer, LIST_CACHE => 'FAULT', SCALAR_CACHE => [HASH => \%cache] for keys %info;
 163         }
 164
 165         my %files;
 166         for my $file (@ARGV) {
 167                 my ($basename, undef, $suffix) = fileparse $file, keys %info;
 168                 next unless $suffix;
 169                 $files{$basename} //= [];
 170                 push @{$files{$basename}}, thaw scalar $info{$suffix}->($file);
 171         }
 172
 173         my $ht=HTML::Template::Compiled->new(
 174                 default_escape => 'HTML',
 175                 global_vars => 2,
 176                 $template eq '' ? (scalarref => \$default_template) : (filename => $template),
 177         );
 178
 179         my @files;
 180         for (sort keys %files) {
 181                 my @versions = @{$files{$_}};
 182                 my %entry = (formats => [], map { $_ => '?' } qw/title artist year album tracknumber tracktotal genre/);
 183                 for my $ver (@versions) {
 184                         push @{$entry{formats}}, {format => $ver->{format}, file => $ver->{file}};
 185                         for my $key (keys %$ver) {
 186                                 $entry{$key} = $ver->{$key} if $ver->{$key} && $ver->{$key} ne '?';
 187                         }
 188                 }
 189                 delete $entry{$_} for qw/format file/;
 190                 $entry{fragment} = make_fragment @entry{qw/artist title/};
 191                 push @files, \%entry
 192         }
 193
 194         @files = sort { $a->{title} cmp $b->{title} } @files;
 195         $ht->param(files => \@files, prefix => $prefix);
 196         print $ht->output; ## no critic (RequireCheckedSyscalls)
 197 }
 198
 199 $default_template = <<'HTML';
 200 <!DOCTYPE html>
 201 <title>Music</title>
 202 <meta charset="utf-8">
 203 <link rel="stylesheet" href="musicexpo.css">
 204 <script async defer type="application/javascript" src="player.js"></script>
 205
 206 <div id="player"></div>
 207
 208 <table border>
 209 <thead>
 210 <tr><th>Title<th>Artist<th>Album<th>Genre<th>Track<th>Year<th>Type
 211 <tbody><tmpl_loop files>
 212 <tr><td class="title"><a href="#<tmpl_var fragment>" data-hash="#<tmpl_var fragment>"><tmpl_var title></a><td class="artist"><tmpl_var artist><td class="album"><tmpl_var album><td class="genre"><tmpl_var genre><td class="track"><tmpl_var tracknumber>/<tmpl_var tracktotal><td class="year"><tmpl_var year><td class="formats"><tmpl_loop formats><a href="<tmpl_var ...prefix><tmpl_var ESCAPE=URL file>"><tmpl_var format></a> </tmpl_loop></tmpl_loop>
 213 </table>
 214 HTML
 215
 216 1;
 217
 218 __END__
 219
 220 =encoding utf-8
 221
 222 =head1 NAME
 223
 224 App::MusicExpo - script which generates a HTML table of music tags
 225
 226 =head1 SYNOPSIS
 227
 228   use App::MusicExpo;
 229   App::MusicExpo->run;
 230
 231 =head1 DESCRIPTION
 232
 233 App::MusicExpo creates a HTML table from a list of songs.
 234
 235 The default template looks like:
 236
 237     | Title   | Artist  | Album           | Genre   | Track | Year | Type |
 238     |---------+---------+-----------------+---------+-------+------+------|
 239     | Cellule | Silence | L'autre endroit | Electro | 01/09 | 2005 | FLAC |
 240
 241 where the type is a download link. If you have multiple files with the same
 242 basename (such as C<cellule.flac> and C<cellule.ogg>), they will be treated
 243 as two versions of the same file, so a row will be created with two download
 244 links, one for each format.
 245
 246 =head1 OPTIONS
 247
 248 =over
 249
 250 =item B<--template> I<template>
 251
 252 Path to the HTML::Template::Compiled template used for generating the music table. If '' (empty), uses the default format. Is empty by default.
 253
 254 =item B<--prefix> I<prefix>
 255
 256 Prefix for download links. Defaults to '/music/'.
 257
 258 =item B<--cache> I<filename>
 259
 260 Path to the cache file. Created if it does not exist. If '' (empty), disables caching. Is empty by default.
 261
 262 =back
 263
 264 =head1 AUTHOR
 265
 266 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
 267
 268 =head1 COPYRIGHT AND LICENSE
 269
 270 Copyright (C) 2013-2016 by Marius Gavrilescu
 271
 272 This library is free software; you can redistribute it and/or modify
 273 it under the same terms as Perl itself, either Perl version 5.14.2 or,
 274 at your option, any later version of Perl 5 you may have available.