Move under www to ease rsync

2025-10-29 10:51:15 +01:00
parent 2bb22c7583
commit 30ad62e938
890 changed files with 0 additions and 0 deletions
--- a/www/eps/hpr3413/hpr3413_show_queue.pl
+++ b/www/eps/hpr3413/hpr3413_show_queue.pl
@@ -0,0 +1,146 @@
+#!/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
+