X-Git-Url: http://git.ieval.ro/?a=blobdiff_plain;f=lib%2FApp%2FMusicExpo.pm;h=c1433ca44c23566cf5ec4808f5c38a26930b9955;hb=17c8e5f607f576c8762858da54c8663e7d9bd7d0;hp=a25a132ba1427f847c361c4760244f9a762b8b9e;hpb=b484a12921835e84ece975361da2c7b209beba6b;p=app-musicexpo.git diff --git a/lib/App/MusicExpo.pm b/lib/App/MusicExpo.pm index a25a132..c1433ca 100644 --- a/lib/App/MusicExpo.pm +++ b/lib/App/MusicExpo.pm @@ -1,9 +1,9 @@ package App::MusicExpo; -use v5.14; +use 5.014000; use strict; use warnings; -our $VERSION = '0.005'; +our $VERSION = '1.001_001'; use Audio::FLAC::Header qw//; use HTML::Template::Compiled qw//; @@ -11,6 +11,7 @@ use Memoize qw/memoize/; use MP3::Info qw/get_mp3tag/; use Ogg::Vorbis::Header::PurePerl; use MP4::Info qw/get_mp4tag get_mp4info/; +use Audio::Opusfile qw//; use DB_File qw//; use Encode qw/encode/; @@ -29,9 +30,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{ @@ -54,7 +55,7 @@ sub flacinfo{ sub mp3info{ my $file=$_[0]; my %tag = map { encode 'UTF-8', $_ } %{get_mp3tag $file}; - my @trkn = split '/', $tag{TRACKNUM} // ''; + my @trkn = split m#/#s, $tag{TRACKNUM} // ''; freeze +{ format => 'MP3', @@ -75,18 +76,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'; @@ -111,6 +112,26 @@ sub 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 %info = ( '.flac' => \&flacinfo, '.mp3' => \&mp3info, @@ -119,6 +140,7 @@ my %info = ( '.mp4' => \&mp4info, '.aac' => \&mp4info, '.m4a' => \&mp4info, + '.opus' => \&opusinfo, ); sub normalizer{ @@ -128,9 +150,8 @@ sub normalizer{ sub make_fragment{ join '-', map { lc =~ y/a-z0-9/_/csr } @_ } 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; } @@ -154,7 +175,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 +185,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 +259,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,