Minor updates

Show_Submission/extract_images: some tidying, addition of more POD documentation. Show_Submission/query2csv, Show_Submission/query2json: these softlinks were turned to hard links to make them more visible in the Git repo. The files are in the 'Database/' directory.
2024-12-31 21:41:52 +00:00
parent 2f350dd1db
commit a3c8586730
3 changed files with 333 additions and 10 deletions
--- a/Show_Submission/query2json
+++ b/Show_Submission/query2json
@@ -1 +0,0 @@
-/home/cendjm/HPR/Database/query2json
--- a/Show_Submission/query2json
+++ b/Show_Submission/query2json
@@ -0,0 +1,134 @@
+#!/usr/bin/env perl
+#===============================================================================
+#
+#         FILE: query2json
+#
+#        USAGE: ./query2json query
+#
+#  DESCRIPTION: Runs a query given as the only argument. Caution is needed
+#               since *any* query will be run. The result of the query is
+#               output in JSON form on STDOUT.
+#
+#      OPTIONS: ---
+# REQUIREMENTS: ---
+#         BUGS: ---
+#        NOTES: Had to revert to MySQL because of a problem with DBD::MariaDB
+#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
+#      VERSION: 0.0.2
+#      CREATED: 2021-06-18 13:24:49
+#     REVISION: 2023-01-05 16:17:24
+#
+#===============================================================================
+
+use 5.010;
+use strict;
+use warnings;
+use utf8;
+
+use Config::General;
+use JSON;
+use DBI;
+
+use Data::Dumper;
+
+#
+# Version number (manually incremented)
+#
+our $VERSION = '0.0.2';
+
+#
+# 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}/HPR/Database";
+my $configfile = "$basedir/.hpr_livedb.cfg";
+
+my ( $dbh, $sth1, $aref1 );
+my ( $query, $result, $json );
+
+#
+# Enable Unicode mode
+#
+binmode STDOUT, ":encoding(UTF-8)";
+binmode STDERR, ":encoding(UTF-8)";
+
+#
+# Load database configuration data
+#
+my $conf = Config::General->new(
+    -ConfigFile      => $configfile,
+    -InterPolateVars => 1,
+    -ExtendedAccess  => 1
+);
+my %config = $conf->getall();
+
+#-------------------------------------------------------------------------------
+# Options and arguments
+#-------------------------------------------------------------------------------
+$query = shift;
+die "Usage: $PROG query\n" unless $query;
+
+#-------------------------------------------------------------------------------
+# Connect to the database
+#-------------------------------------------------------------------------------
+my $dbhost = $config{database}->{host} // '127.0.0.1';
+my $dbport = $config{database}->{port} // 3306;
+my $dbname = $config{database}->{name};
+my $dbuser = $config{database}->{user};
+my $dbpwd  = $config{database}->{password};
+#$dbh = DBI->connect( "DBI:MariaDB:host=$dbhost;port=$dbport;database=$dbname",
+#    $dbuser, $dbpwd, { AutoCommit => 1 } )
+#    or die $DBI::errstr;
+
+$dbh = DBI->connect( "dbi:mysql:host=$dbhost;port=$dbport;database=$dbname",
+    $dbuser, $dbpwd, { AutoCommit => 1 } )
+    or die $DBI::errstr;
+
+#
+# Enable client-side UTF8
+#
+$dbh->{mysql_enable_utf8} = 1;
+
+#
+# Set up the query
+#
+$sth1 = $dbh->prepare($query) or die $DBI::errstr;
+if ( $dbh->err ) {
+    warn $dbh->errstr;
+}
+
+#
+# Perform the query
+#
+$sth1->execute;
+if ( $dbh->err ) {
+    warn $dbh->errstr;
+}
+
+#
+# Grab everything as an arrayref of hashrefs
+#
+$result = $sth1->fetchall_arrayref( {} );
+
+#
+# Prepare for JSON, forcing object key sorting (expensive)
+#
+$json = JSON->new->utf8->canonical;
+
+#
+# Encode the Perl structure to JSON
+#
+print $json->encode($result), "\n";
+
+exit;
+
+# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker