[app-musicexpo.git] / lib / App / MusicExpo.pm

package App::MusicExpo;
use 5.014000;
use strict;
use warnings;

our $VERSION = '1.002001';

use HTML::Template::Compiled qw//;
use Memoize qw/memoize/;

use Carp qw/carp/;
use DB_File qw//;
use Encode qw/encode/;
use File::Basename qw/fileparse/;
use Fcntl qw/O_RDWR O_CREAT/;
use Getopt::Long;
use Storable qw/thaw freeze/;
use sort 'stable';

##################################################

my $default_template;

our $prefix='/music/';
our $cache='';
our $template='';

GetOptions (
	'template:s' => \$template,
	'prefix:s' => \$prefix,
	'cache:s' => \$cache,
);

sub flacinfo{
	my $file=$_[0];
	my $flac=Audio::FLAC::Header->new($file);

	freeze +{
		format => 'FLAC',
		title => $flac->tags('TITLE'),
		artist => $flac->tags('ARTIST'),
		year => $flac->tags('DATE'),
		album => $flac->tags('ALBUM'),
		tracknumber => $flac->tags('TRACKNUMBER'),
		tracktotal => $flac->tags('TRACKTOTAL'),
		genre => $flac->tags('GENRE'),
		file => scalar fileparse $file,
	}
}

sub mp3info{
	my $file=$_[0];
	my %tag = map { encode 'UTF-8', $_ } %{MP3::Info::get_mp3tag $file};
	my @trkn = split m#/#s, $tag{TRACKNUM} // '';

	freeze +{
		format => 'MP3',
		title => $tag{TITLE},
		artist => $tag{ARTIST},
		year => $tag{YEAR},
		album => $tag{ALBUM},
		tracknumber => $trkn[0],
		tracktotal => $trkn[1],
		genre => $tag{GENRE},
		file => scalar fileparse $file,
	}
}

sub vorbisinfo{
	my $file=$_[0];
	my $ogg=Ogg::Vorbis::Header::PurePerl->new($file);

	freeze +{
		format => 'Vorbis',
		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 ($){ ## no critic (ProhibitSubroutinePrototypes)
	my $encoding = $_[0];
	return 'AAC' if $encoding eq 'mp4a';
	return 'ALAC' if $encoding eq 'alac';
	"MP4-$encoding"
}

sub mp4info{
	my $file=$_[0];
	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},
		title => $tag{TITLE},
		artist => $tag{ARTIST},
		year => $tag{YEAR},
		album => $tag{ALBUM},
		tracknumber => $tag{TRACKNUM},
		tracktotal => ($tag{TRKN} ? $tag{TRKN}->[1] : undef),
		genre => $tag{GENRE},
		file => scalar fileparse $file,
	};
}

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 {
	if ($cache) {
		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);
	}

	my $ht=HTML::Template::Compiled->new(
		default_escape => 'HTML',
		global_vars => 2,
		$template eq '' ? (scalarref => \$default_template) : (filename => $template),
	);

	my @files;
	for (sort keys %files) {
		my @versions = @{$files{$_}};
		my %entry = (formats => [], map { $_ => '?' } qw/title artist year album tracknumber tracktotal genre/);
		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} && $ver->{$key} ne '?';
			}
		}
		delete $entry{$_} for qw/format file/;
		$entry{fragment} = make_fragment @entry{qw/artist title/};
		push @files, \%entry
	}

	@files = sort { $a->{title} cmp $b->{title} } @files;
	$ht->param(files => \@files, prefix => $prefix);
	print $ht->output; ## no critic (RequireCheckedSyscalls)
}

$default_template = <<'HTML';
<!DOCTYPE html>
<title>Music</title>
<meta charset="utf-8">
<link rel="stylesheet" href="musicexpo.css">
<script async defer type="application/javascript" src="player.js"></script>

<div id="player"></div>

<table border>
<thead>
<tr><th>Title<th>Artist<th>Album<th>Genre<th>Track<th>Year<th>Type
<tbody><tmpl_loop files>
<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>
</table>
HTML

1;

__END__

=encoding utf-8

=head1 NAME

App::MusicExpo - script which generates a HTML table of music tags

=head1 SYNOPSIS

  use App::MusicExpo;
  App::MusicExpo->run;

=head1 DESCRIPTION

App::MusicExpo creates a HTML table from a list of songs.

The default template looks like:

    | Title   | Artist  | Album           | Genre   | Track | Year | Type |
    |---------+---------+-----------------+---------+-------+------+------|
    | Cellule | Silence | L'autre endroit | Electro | 01/09 | 2005 | FLAC |

where the type is a download link. If you have multiple files with the same
basename (such as C<cellule.flac> and C<cellule.ogg>), they will be treated
as two versions of the same file, so a row will be created with two download
links, one for each format.

=head1 OPTIONS

=over

=item B<--template> I<template>

Path to the HTML::Template::Compiled template used for generating the music table. If '' (empty), uses the default format. Is empty by default.

=item B<--prefix> I<prefix>

Prefix for download links. Defaults to '/music/'.

=item B<--cache> I<filename>

Path to the cache file. Created if it does not exist. If '' (empty), disables caching. Is empty by default.

=back

=head1 AUTHOR

Marius Gavrilescu, E<lt>marius@ieval.roE<gt>

=head1 COPYRIGHT AND LICENSE

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,
at your option, any later version of Perl 5 you may have available.
Commit	Line	Data
	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.