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.
This commit is contained in:
Dave Morriss 2024-12-31 21:41:52 +00:00
parent 2f350dd1db
commit a3c8586730
3 changed files with 333 additions and 10 deletions

View File

@ -7,13 +7,15 @@
# [--prefix=STRING] [--[no-]backup] [--force] [--[no]silent]
# HTML_file [ [HTML_file_2] [HTML_file_3] ... ]
#
# DESCRIPTION: Processes HTML files which may have 'data' URIs containing
# DESCRIPTION: Processes HTML files which may have 'data' scheme URIs containing
# images, and extracts these images into files in the same
# directory. The 'data' scheme links are converted to 'https'
# and reference the extracted files. The modified HTML is
# output, and the original will be saved as a backup if
# requested.
#
# The 'data' URI scheme is specified in RFC 2397.
#
# OPTIONS: ---
# REQUIREMENTS: ---
# BUGS: ---
@ -21,7 +23,7 @@
# AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
# VERSION: 0.0.3
# CREATED: 2024-12-25 10:53:15
# REVISION: 2024-12-30 11:52:59
# REVISION: 2024-12-31 20:56:50
#
#===============================================================================
@ -239,10 +241,11 @@ foreach my $notesfile (@ARGV) {
#
# Construct the filename for this image making sure it's in
# the directory the HTML is in.
# the directory where the HTML is located.
#
# ${fileprefix}_${prefix}_${increment}.${extension}
#
$fcount++;
# ${fileprefix}_${prefix}_${increment}.${extension}
$filename
= "$dirname/${basename}_${prefix}_${fcount}${suffix}";
say "Writing to: $filename" unless $silent;
@ -289,8 +292,9 @@ foreach my $notesfile (@ARGV) {
#$notesfile = path($notesfile)->basename;
if ($backup) {
_backup( $abs_nf, $bsuffix, $backupcount );
say "$notesfile backed up" unless $silent;
if (_backup( $abs_nf, $bsuffix, $backupcount )) {
say "$notesfile backed up" unless $silent;
}
}
else {
say "$notesfile not backed up" unless $silent;
@ -532,7 +536,7 @@ TBA
=item B<2>
TBA
Displays the internal variables used to store the options.
=item B<3>
@ -636,7 +640,57 @@ See the option B<--prefix=STRING> for details of file name generation.
=head1 DIAGNOSTICS
TBA
=over 4
=item B<Unable to find ...>
Type: warning
The script is attempting to find a file presented to it as an argument, but
cannot. It will skip to the next argument and continue.
=item B<File ... is not HTML>
Type: warning
The script is checking files presented to it as arguments. The named file has
been checked to see if it contains HTML, and it appears it does not. It will
skip to the next argument and continue.
=item B<Unable to open ...>
Type: fatal
The script is attempting to open a file presented to it as an argument. Its
existence has already been checked but it cannot be opened, possibly due to
a permissions issue.
=item B<HTML::TreeBuilder failed to parse notes: ...>
Type: fatal
The script has attempted to parse the HTML in a file presented to it. This has
failed. The error message includes a report from the module used to do this.
=item B<File ... exists; not overwriting>
Type: warning
The script is attempting to write an image file copied from the HTML, but has
found it already exists. Using the option B<--force> would cause it to be
overwritten, but this option is not enabled.
The script will not write the file, however, it will still modify the HTML to
reference the existing image file.
=item B<Unable to find ... to backup>
Type: warning
The script is attempting to make a backup of one of the HTML file arguments,
but is unable to find it. Since this is a rather unusual circumstance (has the
file been deleted?), it is assumed it can be regenerated if needed, so the
writing of the modified HTML is continued.
=head1 CONFIGURATION AND ENVIRONMENT

View File

@ -1 +0,0 @@
/home/cendjm/HPR/Database/query2csv

137
Show_Submission/query2csv Executable file
View File

@ -0,0 +1,137 @@
#!/usr/bin/env perl
#===============================================================================
#
# FILE: query2csv
#
# USAGE: ./query2csv 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 CSV form on STDOUT. The CSV is always quoted to
# cater for the more simplistic consumers.
#
# 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: 2015-07-11 15:53:01
# REVISION: 2022-02-16 23:17:16
#
#===============================================================================
use 5.010;
use strict;
use warnings;
use utf8;
use Config::General;
use Text::CSV_XS;
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, $csv );
#
# 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;
}
#
# Prepare to make CSV. Not sure if always quoting is the best idea though
#
$csv = Text::CSV_XS->new(
# { always_quote => 1 }
);
#
# Loop through the returned rows making and printing CSV. Each row is returned
# as an arrayref to make it easy to join everything.
#
while ( $aref1 = $sth1->fetchrow_arrayref ) {
$csv->combine(@$aref1);
print $csv->string(), "\n";
}
exit;
# vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker

View File

@ -1 +0,0 @@
/home/cendjm/HPR/Database/query2json

134
Show_Submission/query2json Executable file
View File

@ -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