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