paulj/hpr-tools
1
0
Fork 0
forked from HPR/hpr-tools
Code Pull Requests Activity

Various updates

Browse Source 
Show_Submission/copy_shownotes: Changed the location of the function library

Show_Submission/do_brave: Updates to the way local stand-alone HTML is generated for
    review purposes.

Show_Submission/do_index: Changed the location of the function library

Show_Submission/do_pandoc: Changed the location of the function library; now uses
    'author_title.pl' to generate YAML for Pandoc

Show_Submission/do_parse: Trivial change

Show_Submission/do_pictures: Changed the location of the function library; better
    handling of the show specification

Show_Submission/do_report: Changed the location of the function library

Show_Submission/do_update_reservations: Changed the location of the function library

Show_Submission/fix_relative_links: Added features 'say' and 'state'

Show_Submission/parse_JSON: New checks: notes too short, trailing spaces on title,
    summary and tags (needing JSON changes). Check for Markdown in the
    assets (see 'do_pandoc_assets'). New 'trim' function.
This commit is contained in:
Dave Morriss
2024-12-01 20:45:20 +00:00
parent 7e925621f4
commit b7cae1cb90
10 changed files with 215 additions and 118 deletions
Download Patch File Download Diff File Expand all files Collapse all files

101
Show_Submission/parse_JSON
View File

@@ -21,14 +21,17 @@
# BUGS: ---
# NOTES: ---
# AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
# VERSION: 0.0.14
# VERSION: 0.0.17
# CREATED: 2020-11-28 10:52:02
# REVISION: 2024-03-09 20:34:54
# REVISION: 2024-10-04 18:37:29
#
#===============================================================================
use 5.30.0;
use v5.36;
use utf8;
use feature qw{ postderef say signatures state try };
no warnings
qw{ experimental::postderef experimental::signatures experimental::try };
use Getopt::Long;
use Pod::Usage;
@@ -57,7 +60,7 @@ use Data::Dumper;
#
# Version number (manually incremented)
#
our $VERSION = '0.0.14';
our $VERSION = '0.0.17';
#
# Script and directory names
@@ -79,7 +82,12 @@ my $logfile = "$logdir/${PROG}.log";
my ( $snlevel, $showno, $summarylength, $notelength );
our $MARKUP_DETECTED = 0;
#
# Maximum and minimum number of characters (bytes)
#
my $MAXNOTELEN = 4000;
my $MINNOTELEN = 10;
#
# Printing: general output format
@@ -223,13 +231,14 @@ my @markup_types = (
my @markup_found;
my $markup_choice;
my ( $showdir, $assetdir , $statusfile );
my ( $showdir, $assetdir, $statusfile );
my ( %media_files, $media_files );
my ( %assets, @assets, @audio, $sanitised );
my ( $has_audio, $has_extra, $has_archives );
my ( @archives, @extracted );
my ( $astate, $has_pictures, @pictures, $pictures );
my ( %spellchecks );
my ( $has_markup, @markup, $markup );
my ( $json_change, @json_changes, %spellchecks );
my @pstates = (
'No pictures found', # 0
'Pictures that need management', # 1
@@ -347,8 +356,13 @@ open( my $fh, '<:encoding(UTF-8)', $infile );
my $json_text = <$fh>;
close($fh);
# TODO: bad JSON can crash the script here!
my $content = decode_json($json_text);
my $content;
try {
$content = decode_json($json_text);
}
catch ($e) {
die colored( "Failed to decode the JSON in $infile", 'red' ) . "\n"
}
$log->info( $showno, "[$VERSION] Processing $infile" );
@@ -372,6 +386,19 @@ print STDERR '-' x 80, "\n";
printf STDERR $ofmt, "Show:", $content->{metadata}{Episode_Number};
printf STDERR $ofmt, "Date:", $content->{metadata}{Episode_Date};
#
# Trim off leading and trailing spaces in these fields
#
$json_change = 0;
for my $key ( 'Title', 'Summary', 'Tags' ) {
my $str = trim($content->{episode}{$key});
if ($str ne $content->{episode}{$key}) {
$content->{episode}{$key} = $str;
$json_change = 1;
push(@json_changes,$key);
}
}
#
# Detect Unicode in the Title, Summary or Tags and flag their presence.
#
@@ -386,6 +413,9 @@ for my $key ( 'Title', 'Summary', 'Tags' ) {
);
}
alert( $ofmt, "JSON to be updated; changes to: " .
join(',',@json_changes) ) if $json_change;
#
# Check summary length. The field might be filled and something might have
# been lost.
@@ -429,7 +459,12 @@ printf STDERR $ofmt, "Notes:", $snlevel . " HTML start/end tags found";
$notelength = length( $content->{episode}{Show_Notes} );
if ( $notelength > $MAXNOTELEN ) {
printf STDERR $ofmt, "Notes:",
colored( "Notes are longer than $MAXNOTELEN ($notelength)",
colored( "Notes are longer than $MAXNOTELEN bytes ($notelength)",
'bold yellow on_magenta' );
}
elsif ( $notelength <= $MINNOTELEN ) {
printf STDERR $ofmt, "Notes:",
colored( "Notes are shorter than $MINNOTELEN bytes ($notelength)",
'bold yellow on_magenta' );
}
@@ -651,6 +686,17 @@ if (%media_files) {
_debug( $DEBUG > 2, '@assets: ' . Dumper( \@assets ) );
}
#-------------------------------------------------------------------------------
# Look for un-processed markup in the assets hash. For the moment we
# only look for Markdown.
#-------------------------------------------------------------------------------
$has_markup = @markup
= grep { $assets{$_}->{type} =~ m{^text/markdown$} } keys(%assets);
$markup = join( ', ', @markup );
if (@markup) {
_debug( $DEBUG > 2, '@markup ' . Dumper( \@markup ) );
}
#-------------------------------------------------------------------------------
# Look for archive files in the assets
#-------------------------------------------------------------------------------
@@ -690,6 +736,11 @@ if (%media_files) {
@assets = array_difference(\@assets,\@archives);
push(@assets, @extracted);
#
# Remove markup files from the assets so we don't upload them
#
@assets = array_difference(\@assets,\@markup);
#
# Remove directory stuff from @assets elements and %assets keys
#
@@ -745,6 +796,8 @@ if (%media_files) {
$log->info( $showno, "Media files: $media_files" ) if ($media_files);
$log->info( $showno, "Pictures: " . join( ', ', @pictures ) )
if (@pictures);
$log->info( $showno, "Markup " . join( ', ', @markup ) )
if (@markup);
$log->info( $showno, "Assets: " . join( ', ', @assets ) )
if (@assets);
@@ -849,7 +902,6 @@ if ( $snlevel > 0 && $content->{metadata}{Shownotes_Format} =~ /html5/i ) {
"Apparently incorrect URLs detected in the notes", 'red'
), "\n";
}
}
#
@@ -866,6 +918,15 @@ if ( $markup_choice eq 'html5'
"Declared format 'plain_text' but notes seem to be HTML5!" );
}
#
# 7. The host has sent in markup version(s) of their external notes, so we
# need to take special action.
#
if ($markup) {
printf STDERR "%s\n",
textFormat( $markup, 'Markup files:', 'L', 18, 80 );
}
#-------------------------------------------------------------------------------
# Determine the picture asset state
#-------------------------------------------------------------------------------
@@ -1709,6 +1770,23 @@ sub find_Unicode {
return ( $string =~ /[^\x{00}-\x{7F}]/ );
}
#=== FUNCTION ================================================================
# NAME: trim
# PURPOSE: Trims leading and trailing spaces from a string
# PARAMETERS: string string to trim
# RETURNS: Trimmed string
# DESCRIPTION:
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub trim {
my ($str) = @_;
$str =~ s/^\s+|\s+$//g;
return $str;
}
#=== FUNCTION ================================================================
# NAME: output_file_name
# PURPOSE: Generate an output file name with three choices
@@ -1969,7 +2047,6 @@ sub alert {
my ( $fmt, $message ) = @_;
$fmt = "%-16s %s\n" unless $fmt;
# print STDERR "$bold$red", sprintf( $fmt, "** ALERT **:", $message ), "$reset";
print STDERR colored( sprintf( $fmt, "** ALERT **:", $message ),
'bold red' );
}
@@ -2082,7 +2159,7 @@ parse_JSON - parse the JSON output file from the HPR show submission form
=head1 VERSION
This documentation refers to parse_JSON version 0.0.14
This documentation refers to parse_JSON version 0.0.17
=head1 USAGE