X-Git-Url: http://git.ieval.ro/?a=blobdiff_plain;f=lib%2FApp%2FMusicExpo.pm;h=9f7de60d23804b309cad96209c80f123a3b50bdf;hb=fb40d666a8878b8272656e9de7ef7374f2ec3627;hp=a25a132ba1427f847c361c4760244f9a762b8b9e;hpb=b484a12921835e84ece975361da2c7b209beba6b;p=app-musicexpo.git diff --git a/lib/App/MusicExpo.pm b/lib/App/MusicExpo.pm index a25a132..9f7de60 100644 --- a/lib/App/MusicExpo.pm +++ b/lib/App/MusicExpo.pm @@ -1,17 +1,14 @@ package App::MusicExpo; -use v5.14; +use 5.014000; use strict; use warnings; -our $VERSION = '0.005'; +our $VERSION = '1.002001'; -use Audio::FLAC::Header qw//; use HTML::Template::Compiled qw//; use Memoize qw/memoize/; -use MP3::Info qw/get_mp3tag/; -use Ogg::Vorbis::Header::PurePerl; -use MP4::Info qw/get_mp4tag get_mp4info/; +use Carp qw/carp/; use DB_File qw//; use Encode qw/encode/; use File::Basename qw/fileparse/; @@ -29,9 +26,9 @@ our $cache=''; our $template=''; GetOptions ( - "template:s" => \$template, - "prefix:s" => \$prefix, - "cache:s" => \$cache, + 'template:s' => \$template, + 'prefix:s' => \$prefix, + 'cache:s' => \$cache, ); sub flacinfo{ @@ -53,8 +50,8 @@ sub flacinfo{ sub mp3info{ my $file=$_[0]; - my %tag = map { encode 'UTF-8', $_ } %{get_mp3tag $file}; - my @trkn = split '/', $tag{TRACKNUM} // ''; + my %tag = map { encode 'UTF-8', $_ } %{MP3::Info::get_mp3tag $file}; + my @trkn = split m#/#s, $tag{TRACKNUM} // ''; freeze +{ format => 'MP3', @@ -75,18 +72,18 @@ sub vorbisinfo{ freeze +{ format => 'Vorbis', - title => $ogg->comment('TITLE'), - artist => $ogg->comment('artist'), - year => $ogg->comment('DATE'), - album => $ogg->comment('ALBUM'), - tracknumber => $ogg->comment('TRACKNUMBER'), - tracktotal => $ogg->comment('TRACKTOTAL'), - genre => $ogg->comment('GENRE'), + title => scalar $ogg->comment('TITLE'), + artist => scalar $ogg->comment('artist'), + year => scalar $ogg->comment('DATE'), + album => scalar $ogg->comment('ALBUM'), + tracknumber => scalar $ogg->comment('TRACKNUMBER'), + tracktotal => scalar $ogg->comment('TRACKTOTAL'), + genre => scalar $ogg->comment('GENRE'), file => scalar fileparse $file, } } -sub mp4_format ($){ +sub mp4_format ($){ ## no critic (ProhibitSubroutinePrototypes) my $encoding = $_[0]; return 'AAC' if $encoding eq 'mp4a'; return 'ALAC' if $encoding eq 'alac'; @@ -95,8 +92,8 @@ sub mp4_format ($){ sub mp4info{ my $file=$_[0]; - my %tag = map { ref() ? $_ : encode 'UTF-8', $_ } %{get_mp4tag $file}; - my %info = %{get_mp4info $file}; + my %tag = map { ref() ? $_ : encode 'UTF-8', $_ } %{MP4::Info::get_mp4tag $file}; + my %info = %{MP4::Info::get_mp4info $file}; freeze +{ format => mp4_format $info{ENCODING}, @@ -111,32 +108,65 @@ sub mp4info{ }; } -my %info = ( - '.flac' => \&flacinfo, - '.mp3' => \&mp3info, - '.ogg' => \&vorbisinfo, - '.oga' => \&vorbisinfo, - '.mp4' => \&mp4info, - '.aac' => \&mp4info, - '.m4a' => \&mp4info, +sub opusinfo { + my $file = $_[0]; + my $of = Audio::Opusfile->new_from_file($file); + my $tags = $of->tags; + + my %data = ( + format => 'Opus', + title => $tags->query('TITLE'), + artist => $tags->query('ARTIST'), + year => $tags->query('DATE'), + album => $tags->query('ALBUM'), + tracknumber => $tags->query('TRACKNUMBER'), + tracktotal => $tags->query('TRACKTOTAL'), + genre => $tags->query('GENRE'), + file => scalar fileparse $file, + ); + + freeze \%data; +} + +my @optional_modules = ( + [ 'Audio::FLAC::Header', \&flacinfo, '.flac' ], + [ 'MP3::Info', \&mp3info, '.mp3' ], + [ 'Ogg::Vorbis::Header::PurePerl', \&vorbisinfo, '.ogg', '.oga' ], + [ 'MP4::Info', \&mp4info, '.mp4', '.aac', '.m4a' ], + [ 'Audio::Opusfile', \&opusinfo, '.opus' ], ); +my %info; + +for (@optional_modules) { + my ($module, $coderef, @extensions_handled) = @$_; + if (eval "require $module") { + $info{$_} = $coderef for @extensions_handled + } +} + +unless (%info) { + carp 'No tags-reading module detected. Install one of the following modules: ' . join ', ', map { $_->[0] } @optional_modules; +} + sub normalizer{ "$_[0]|".(stat $_[0])[9] } sub make_fragment{ join '-', map { lc =~ y/a-z0-9/_/csr } @_ } +sub extensions_handled { keys %info } + sub run { - my %info = %info; if ($cache) { - tie my %cache, 'DB_File', $cache, O_RDWR|O_CREAT, 0644; + tie my %cache, 'DB_File', $cache, O_RDWR|O_CREAT, 0644; ## no critic (ProhibitTie) $info{$_} = memoize $info{$_}, INSTALL => undef, NORMALIZER => \&normalizer, LIST_CACHE => 'FAULT', SCALAR_CACHE => [HASH => \%cache] for keys %info; } my %files; for my $file (@ARGV) { my ($basename, undef, $suffix) = fileparse $file, keys %info; + next unless $suffix; $files{$basename} //= []; push @{$files{$basename}}, thaw scalar $info{$suffix}->($file); } @@ -154,7 +184,7 @@ sub run { for my $ver (@versions) { push @{$entry{formats}}, {format => $ver->{format}, file => $ver->{file}}; for my $key (keys %$ver) { - $entry{$key} = $ver->{$key} if $ver->{$key} ne '?'; + $entry{$key} = $ver->{$key} if $ver->{$key} && $ver->{$key} ne '?'; } } delete $entry{$_} for qw/format file/; @@ -164,7 +194,7 @@ sub run { @files = sort { $a->{title} cmp $b->{title} } @files; $ht->param(files => \@files, prefix => $prefix); - print $ht->output; + print $ht->output; ## no critic (RequireCheckedSyscalls) } $default_template = <<'HTML'; @@ -238,7 +268,7 @@ Marius Gavrilescu, Emarius@ieval.roE =head1 COPYRIGHT AND LICENSE -Copyright (C) 2013-2015 by Marius Gavrilescu +Copyright (C) 2013-2016 by Marius Gavrilescu This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself, either Perl version 5.14.2 or,