From a3c8586730ee22df1a3e993ed3b000bdc15b652e Mon Sep 17 00:00:00 2001 From: Dave Morriss Date: Tue, 31 Dec 2024 21:41:52 +0000 Subject: [PATCH] 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. --- Show_Submission/extract_images | 70 +++++++++++++++-- Show_Submission/query2csv | 138 ++++++++++++++++++++++++++++++++- Show_Submission/query2json | 135 +++++++++++++++++++++++++++++++- 3 files changed, 333 insertions(+), 10 deletions(-) mode change 120000 => 100755 Show_Submission/query2csv mode change 120000 => 100755 Show_Submission/query2json diff --git a/Show_Submission/extract_images b/Show_Submission/extract_images index f542ba0..7418333 100755 --- a/Show_Submission/extract_images +++ b/Show_Submission/extract_images @@ -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 + +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 + +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 + +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 + +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 + +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 + +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 diff --git a/Show_Submission/query2csv b/Show_Submission/query2csv deleted file mode 120000 index 266ea6c..0000000 --- a/Show_Submission/query2csv +++ /dev/null @@ -1 +0,0 @@ -/home/cendjm/HPR/Database/query2csv \ No newline at end of file diff --git a/Show_Submission/query2csv b/Show_Submission/query2csv new file mode 100755 index 0000000..0da7eb3 --- /dev/null +++ b/Show_Submission/query2csv @@ -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 + diff --git a/Show_Submission/query2json b/Show_Submission/query2json deleted file mode 120000 index d29e6cc..0000000 --- a/Show_Submission/query2json +++ /dev/null @@ -1 +0,0 @@ -/home/cendjm/HPR/Database/query2json \ No newline at end of file diff --git a/Show_Submission/query2json b/Show_Submission/query2json new file mode 100755 index 0000000..d952a04 --- /dev/null +++ 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