147 lines
3.5 KiB
Perl
Executable File
147 lines
3.5 KiB
Perl
Executable File
#!/usr/bin/env perl
|
|
#===============================================================================
|
|
#
|
|
# FILE: show_queue.pl
|
|
#
|
|
# USAGE: ./show_queue.pl
|
|
#
|
|
# DESCRIPTION: Perform what the old 'show_queue' Bash script used to do but
|
|
# using the new Magnatune SQLite database. Do it in Perl because
|
|
# using a Bash coprocess is a pain.
|
|
#
|
|
# OPTIONS: ---
|
|
# REQUIREMENTS: ---
|
|
# BUGS: ---
|
|
# NOTES: ---
|
|
# AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
|
|
# VERSION: 0.0.1
|
|
# CREATED: 2021-08-05 18:40:22
|
|
# REVISION: 2021-08-05 22:19:38
|
|
#
|
|
#===============================================================================
|
|
|
|
use 5.010;
|
|
use strict;
|
|
use warnings;
|
|
use utf8;
|
|
use feature qw{ postderef say signatures state };
|
|
#no warnings qw{ experimental::postderef experimental::signatures } ;
|
|
|
|
use DBI;
|
|
|
|
use Data::Dumper;
|
|
|
|
#
|
|
# Version number (manually incremented)
|
|
#
|
|
our $VERSION = '0.0.1';
|
|
|
|
#
|
|
# Script and directory names
|
|
#
|
|
( my $PROG = $0 ) =~ s|.*/||mx;
|
|
( my $DIR = $0 ) =~ s|/?[^/]*$||mx;
|
|
$DIR = '.' unless $DIR;
|
|
|
|
#-------------------------------------------------------------------------------
|
|
# Declarations
|
|
#-------------------------------------------------------------------------------
|
|
#
|
|
# Constants and other declarations
|
|
#
|
|
my $basedir = "$ENV{HOME}/MusicDownloads";
|
|
my $datadir = "$basedir/Magnatune_Data";
|
|
my $scriptdir = "$basedir/magnatune-downloader";
|
|
my $queue = "$scriptdir/pending";
|
|
my $db = "$datadir/sqlite_normalized.db";
|
|
|
|
my ( $dbh1, $sth1, $h1 );
|
|
my ( $fmt, $count, $sku );
|
|
|
|
#
|
|
# Enable Unicode mode
|
|
#
|
|
binmode STDOUT, ":encoding(UTF-8)";
|
|
binmode STDERR, ":encoding(UTF-8)";
|
|
|
|
my $dbh
|
|
= DBI->connect( "dbi:SQLite:dbname=$db", "", "",
|
|
{ AutoCommit => 1, sqlite_unicode => 1, } )
|
|
or die $DBI::errstr;
|
|
|
|
my $re = '^http://magnatune.com/artists/albums/([A-Za-z0-9-]+)/?$';
|
|
|
|
#
|
|
# Define the query we need
|
|
#
|
|
my $sql = q{
|
|
SELECT
|
|
ar.name AS artist,
|
|
al.name AS album,
|
|
group_concat(distinct ge.name) AS genre,
|
|
group_concat(distinct sg.name) AS subgenre,
|
|
al.sku as code
|
|
FROM albums al
|
|
JOIN artists ar ON al.artist_id = ar.artists_id
|
|
JOIN genres_albums ga on al.album_id = ga.album_id
|
|
JOIN genres ge ON ge.genre_id = ga.genre_id
|
|
JOIN subgenres_albums sa on al.album_id = sa.album_id
|
|
JOIN subgenres sg ON sg.subgenre_id = sa.subgenre_id
|
|
GROUP BY al.album_id
|
|
HAVING sku = ?;
|
|
};
|
|
|
|
#
|
|
# Format string for printf
|
|
#
|
|
$fmt = "%-9s %s\n";
|
|
|
|
#
|
|
# Open the queue
|
|
#
|
|
open( my $qfh, '<', $queue ) or die "Unable to open $queue`n`";
|
|
|
|
#
|
|
# Set up the query for repeated calls
|
|
#
|
|
$sth1 = $dbh->prepare($sql) or die $DBI::errstr;
|
|
|
|
#
|
|
# Loop through the queue, reporting the details for each album
|
|
#
|
|
$count = 0;
|
|
while ( my $url = <$qfh> ) {
|
|
$count++;
|
|
|
|
chomp($url);
|
|
|
|
#
|
|
# Parse the URL for the SKU component and use it to search. Skip if the
|
|
# parsing fails or the SKU is not found
|
|
#
|
|
if ( ($sku) = ( $url =~ $re ) ) {
|
|
$sth1->execute($sku);
|
|
if ( $h1 = $sth1->fetchrow_hashref() ) {
|
|
printf $fmt, 'Artist:', $h1->{artist};
|
|
printf $fmt, 'Album:', $h1->{album};
|
|
printf $fmt, 'Genre:', $h1->{genre};
|
|
printf $fmt, 'Subgenre:', $h1->{subgenre};
|
|
printf $fmt, 'Code:', $h1->{code};
|
|
print '-' x 9, "\n";
|
|
}
|
|
else {
|
|
say "Could not find SKU $sku";
|
|
}
|
|
}
|
|
else {
|
|
say "Problem parsing URL in queue (line $count): $url";
|
|
}
|
|
}
|
|
|
|
close($qfh);
|
|
|
|
exit;
|
|
|
|
# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker
|
|
|