]>
iEval git - app-musicexpo.git/blob - lib/App/MusicExpo.pm
1 package App
::MusicExpo
;
6 our $VERSION = '1.002001';
8 use HTML
::Template
::Compiled qw
//;
9 use Memoize qw
/memoize/;
12 use Encode qw
/encode/;
13 use File
::Basename qw
/fileparse/;
14 use Fcntl qw
/O_RDWR O_CREAT/;
16 use Storable qw
/thaw freeze/;
19 ##################################################
23 our $prefix='/music/';
28 'template:s' => \
$template,
29 'prefix:s' => \
$prefix,
35 my $flac=Audio
::FLAC
::Header
->new($file);
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,
52 my %tag = map { encode
'UTF-8', $_ } %{MP3
::Info
::get_mp3tag
$file};
53 my @trkn = split m
#/#s, $tag{TRACKNUM} // '';
58 artist
=> $tag{ARTIST
},
61 tracknumber
=> $trkn[0],
62 tracktotal
=> $trkn[1],
64 file
=> scalar fileparse
$file,
70 my $ogg=Ogg
::Vorbis
::Header
::PurePerl
->new($file);
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,
85 sub mp4_format
($){ ## no critic (ProhibitSubroutinePrototypes)
87 return 'AAC' if $encoding eq 'mp4a';
88 return 'ALAC' if $encoding eq 'alac';
94 my %tag = map { ref() ?
$_ : encode
'UTF-8', $_ } %{MP4
::Info
::get_mp4tag
$file};
95 my %info = %{MP4
::Info
::get_mp4info
$file};
98 format
=> mp4_format
$info{ENCODING
},
100 artist
=> $tag{ARTIST
},
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,
112 my $of = Audio
::Opusfile
->new_from_file($file);
113 my $tags = $of->tags;
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
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' ]
140 for (@optional_modules) {
141 my ($module, $coderef, @extensions_handled) = @
$_;
142 if (eval "require $module") {
143 $info{$_} = $coderef for @extensions_handled
148 warn 'No tags-reading module detected. Install one of the following modules: ' . join ', ', map { $_->[0] } @optional_modules;
152 "$_[0]|".(stat $_[0])[9]
155 sub make_fragment
{ join '-', map { lc =~ y/a-z0-9/_/csr } @_ }
157 sub extensions_handled
{ keys %info }
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;
166 for my $file (@ARGV) {
167 my ($basename, undef, $suffix) = fileparse
$file, keys %info;
169 $files{$basename} //= [];
170 push @
{$files{$basename}}, thaw
scalar $info{$suffix}->($file);
173 my $ht=HTML
::Template
::Compiled
->new(
174 default_escape
=> 'HTML',
176 $template eq '' ?
(scalarref
=> \
$default_template) : (filename
=> $template),
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 '?';
189 delete $entry{$_} for qw
/format file/;
190 $entry{fragment
} = make_fragment
@entry{qw
/artist title/};
194 @files = sort { $a->{title
} cmp $b->{title
} } @files;
195 $ht->param(files
=> \
@files, prefix
=> $prefix);
196 print $ht->output; ## no critic (RequireCheckedSyscalls)
199 $default_template = <<'HTML';
202 <meta charset="utf-8">
203 <link rel="stylesheet" href="musicexpo.css">
204 <script async defer type="application/javascript" src="player.js"></script>
206 <div id="player"></div>
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>
224 App::MusicExpo - script which generates a HTML table of music tags
233 App::MusicExpo creates a HTML table from a list of songs.
235 The default template looks like:
237 | Title | Artist | Album | Genre | Track | Year | Type |
238 |---------+---------+-----------------+---------+-------+------+------|
239 | Cellule | Silence | L'autre endroit | Electro | 01/09 | 2005 | FLAC |
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.
250 =item B<--template> I<template>
252 Path to the HTML::Template::Compiled template used for generating the music table. If '' (empty), uses the default format. Is empty by default.
254 =item B<--prefix> I<prefix>
256 Prefix for download links. Defaults to '/music/'.
258 =item B<--cache> I<filename>
260 Path to the cache file. Created if it does not exist. If '' (empty), disables caching. Is empty by default.
266 Marius Gavrilescu, E<lt>marius@ieval.roE<gt>
268 =head1 COPYRIGHT AND LICENSE
270 Copyright (C) 2013-2016 by Marius Gavrilescu
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.
This page took 0.069699 seconds and 4 git commands to generate.