forked from HPR/hpr-tools
		
	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:
		| @@ -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 | ||||
|  | ||||
|   | ||||
| @@ -1 +0,0 @@ | ||||
| /home/cendjm/HPR/Database/query2csv | ||||
							
								
								
									
										137
									
								
								Show_Submission/query2csv
									
									
									
									
									
										Executable file
									
								
							
							
						
						
									
										137
									
								
								Show_Submission/query2csv
									
									
									
									
									
										Executable 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 | ||||
|  | ||||
| @@ -1 +0,0 @@ | ||||
| /home/cendjm/HPR/Database/query2json | ||||
							
								
								
									
										134
									
								
								Show_Submission/query2json
									
									
									
									
									
										Executable file
									
								
							
							
						
						
									
										134
									
								
								Show_Submission/query2json
									
									
									
									
									
										Executable 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 | ||||
		Reference in New Issue
	
	Block a user