forked from HPR/hpr-tools
		
	Moved project directories and files to an empty local repo
This commit is contained in:
		
							
								
								
									
										881
									
								
								Show_Submission/edit_shownotes
									
									
									
									
									
										Executable file
									
								
							
							
						
						
									
										881
									
								
								Show_Submission/edit_shownotes
									
									
									
									
									
										Executable file
									
								
							| @@ -0,0 +1,881 @@ | ||||
| #!/usr/bin/env perl | ||||
| #=============================================================================== | ||||
| # | ||||
| #         FILE: edit_shownotes | ||||
| # | ||||
| #        USAGE: ./edit_shownotes [-help] [-debug=N] [-field=NAME] -episode=N | ||||
| # | ||||
| #  DESCRIPTION: Perform edits on metadata in show notes | ||||
| # | ||||
| #      OPTIONS: --- | ||||
| # REQUIREMENTS: --- | ||||
| #         BUGS: --- | ||||
| #        NOTES: 2022-12-20: originally written to update the shownotes.txt | ||||
| #               file as well as shownotes.json. Now we are phasing out the | ||||
| #               former and using just the JSON, so the former file is not | ||||
| #               being edited. | ||||
| #       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com | ||||
| #      VERSION: 0.0.5 | ||||
| #      CREATED: 2022-12-07 13:05:40 | ||||
| #     REVISION: 2024-04-27 22:41:24 | ||||
| # | ||||
| #=============================================================================== | ||||
|  | ||||
| use v5.36; | ||||
| use strict; | ||||
| use warnings; | ||||
| 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 qw{pod2usage}; | ||||
|  | ||||
| use Term::ANSIColor; | ||||
| use File::Temp; | ||||
| use File::Slurper qw{ read_text write_text }; | ||||
| use File::Copy; | ||||
|  | ||||
| use JSON; | ||||
|  | ||||
| use Log::Handler; | ||||
|  | ||||
| use Data::Dumper; | ||||
|  | ||||
| # | ||||
| # Version number (manually incremented) | ||||
| # | ||||
| our $VERSION = '0.0.5'; | ||||
|  | ||||
| # | ||||
| # 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/Show_Submission"; | ||||
| my $cache   = "$basedir/shownotes"; | ||||
| my $logdir  = "$basedir/logs"; | ||||
| my $logfile = "$logdir/${PROG}.log"; | ||||
|  | ||||
| my ( $fh,       $showno, $showid ); | ||||
| my ( $jsonfile, $jsonfile_bk, $json_text, $JSON_content ); | ||||
| my ( $before,   $field_contents ); | ||||
| #my ( $txtfile,  $txtfile_bk, $txtstring, @txtbuffer ); | ||||
|  | ||||
| # | ||||
| # Text colours | ||||
| # | ||||
| my $red     = color('red'); | ||||
| my $green   = color('green'); | ||||
| my $yellow  = color('yellow'); | ||||
| my $magenta = color('magenta'); | ||||
| my $bold    = color('bold'); | ||||
| my $reset   = color('reset'); | ||||
|  | ||||
| # | ||||
| # How to find (and edit) the fields in shownotes.{txt,json}. | ||||
| # The fields are 'tags', 'title' and 'summary'. | ||||
| # If the JSON file is being edited the primary field offered to the editor is | ||||
| # the first in the array (e.g. 'episode.Tags') and the other one simply echoes | ||||
| # it. | ||||
| # NOTE: 2022-12-20 - stopped modifying the shownotes.txt file | ||||
| # | ||||
| # If the TXT file is being updated (from the primary JSON version edited | ||||
| # earlier) we find it in the array holding the text file using the 'regex' | ||||
| # value, and build a new line using the 'label' value. | ||||
| # This will be cleaned up when the TXT variant is dropped. | ||||
| # | ||||
| my %fields = ( | ||||
|     'tags' => { | ||||
|         'json' => [ 'episode.Tags', 'metadata.POST.tags' ], | ||||
| #        'txt'  => { regex => qr{^Tags:}, label => 'Tags', }, | ||||
|     }, | ||||
|     'title' => { | ||||
|         'json' => [ 'episode.Title', 'metadata.POST.title' ], | ||||
| #        'txt'  => { regex => qr{^Title:}, label => 'Title', }, | ||||
|     }, | ||||
|     'summary' => { | ||||
|         'json' => [ 'episode.Summary', 'metadata.POST.summary' ], | ||||
| #        'txt'  => { regex => qr{^Summary:}, label => 'Summary', }, | ||||
|     }, | ||||
| ); | ||||
|  | ||||
| # | ||||
| # Enable Unicode mode | ||||
| # | ||||
| binmode STDOUT, ":encoding(UTF-8)"; | ||||
| binmode STDERR, ":encoding(UTF-8)"; | ||||
|  | ||||
| #------------------------------------------------------------------------------- | ||||
| # Options and arguments | ||||
| #------------------------------------------------------------------------------- | ||||
| my $DEF_DEBUG = 0; | ||||
| my $DEF_FIELD = 'tags'; | ||||
|  | ||||
| # | ||||
| # Process options | ||||
| # | ||||
| my %options; | ||||
| Options( \%options ); | ||||
|  | ||||
| # | ||||
| # Default help | ||||
| # | ||||
| pod2usage( | ||||
|     -msg     => "$PROG version $VERSION\n", | ||||
|     -verbose => 0, | ||||
|     -exitval => 1 | ||||
| ) if ( $options{'help'} ); | ||||
|  | ||||
| # | ||||
| # Detailed help | ||||
| # | ||||
| pod2usage( | ||||
|     -msg       => "$PROG version $VERSION\n", | ||||
|     -verbose   => 2, | ||||
|     -exitval   => 1, | ||||
| ) if ( $options{'documentation'} ); | ||||
|  | ||||
| # | ||||
| # Collect options | ||||
| # | ||||
| my $DEBUG = ( defined( $options{debug} ) ? $options{debug} : $DEF_DEBUG ); | ||||
| my $field = ( defined( $options{field} ) ? $options{field} : $DEF_FIELD ); | ||||
|  | ||||
| my $test_dir = $options{test_dir}; | ||||
|  | ||||
| $showno = $options{episode}; | ||||
| pod2usage( | ||||
|     -msg     => "$PROG version $VERSION\nMissing mandatory option -episode\n", | ||||
|     -verbose => 0, | ||||
|     -exitval => 1 | ||||
| ) unless $showno; | ||||
|  | ||||
| # | ||||
| # Make an id in 'hpr1234' format | ||||
| # | ||||
| $showid = sprintf('hpr%04d',$showno); | ||||
|  | ||||
| # | ||||
| # Check that the -field=FIELD option is valid | ||||
| # | ||||
| die "Invalid field specification: $field\n" | ||||
|     unless ($field =~ /^(tags|title|summary)$/); | ||||
|  | ||||
| # | ||||
| # The files we'll parse and/or edit (and that we'll backup to). Check the | ||||
| # former exist. | ||||
| # If we've received a test directory we'll run in test mode | ||||
| # | ||||
| if ($test_dir) { | ||||
|     # | ||||
|     # We need a directory here so remove any file component. | ||||
|     # | ||||
|     die "Missing path $test_dir\n" unless ( -e $test_dir ); | ||||
|     unless (-d $test_dir) { | ||||
|         # | ||||
|         # Trim a file path to what is likely to be a directory only, and test | ||||
|         # it exists. Add a trailing '/' if none. | ||||
|         # | ||||
|         $test_dir =~ s|/?[^/]*$||mx; | ||||
|         die "Missing directory $test_dir\n" unless ( -d $test_dir ); | ||||
|         $test_dir .= '/' unless ($test_dir =~ qr{/$}); | ||||
|     } | ||||
|  | ||||
|     # | ||||
|     # Look in the test place | ||||
|     # | ||||
|     $jsonfile = "$test_dir/shownotes.json"; | ||||
| #    $txtfile  = "$test_dir/shownotes.txt"; | ||||
|  | ||||
|     $jsonfile_bk = "$test_dir/shownotes.json.orig"; | ||||
| #    $txtfile_bk  = "$test_dir/shownotes.txt.orig"; | ||||
| } | ||||
| else { | ||||
|     # | ||||
|     # Look in the default place | ||||
|     # | ||||
|     $jsonfile = "$cache/$showid/shownotes.json"; | ||||
| #    $txtfile  = "$cache/$showid/shownotes.txt"; | ||||
|  | ||||
|     $jsonfile_bk = "$cache/$showid/shownotes.json.orig"; | ||||
| #    $txtfile_bk  = "$cache/$showid/shownotes.txt.orig"; | ||||
| } | ||||
|  | ||||
| die colored( "Unable to find JSON file $jsonfile", 'red' ) . "\n" | ||||
|     unless ( -e $jsonfile ); | ||||
| #die colored( "Unable to find text file $txtfile", 'red' ) . "\n" | ||||
| #    unless ( -e $txtfile ); | ||||
|  | ||||
| #------------------------------------------------------------------------------- | ||||
| # Set up logging keeping the default log layout except for the date. The format | ||||
| # is "%T [%L] %m" where '%T' is the timestamp, '%L' is the log level and '%m is | ||||
| # the message. We fiddle with this to implement a 'Test' mode. | ||||
| #------------------------------------------------------------------------------- | ||||
| my $log = Log::Handler->new(); | ||||
|  | ||||
| $log->add( | ||||
|     file => { | ||||
|         timeformat     => "%Y/%m/%d %H:%M:%S", | ||||
|         message_layout => (defined($test_dir) ? "%T [%L] TEST %m" : "%T [%L] %m"), | ||||
|         filename       => $logfile, | ||||
|         minlevel       => 0, | ||||
|         maxlevel       => 7, | ||||
|     } | ||||
| ); | ||||
|  | ||||
| #------------------------------------------------------------------------------- | ||||
| #  Read the JSON input file and parse it into $JSON_content (hashref) | ||||
| #------------------------------------------------------------------------------- | ||||
| my $json = JSON->new->utf8; | ||||
| open( $fh, '<:encoding(UTF-8)', $jsonfile ); | ||||
| $json_text = <$fh>; | ||||
| close($fh); | ||||
|  | ||||
| # | ||||
| # Careful! Bad JSON can crash the script here! | ||||
| # | ||||
| try { | ||||
|     $JSON_content = decode_json($json_text); | ||||
| } | ||||
| catch ($e) { | ||||
|     die colored( "Failed to decode the JSON in $jsonfile", 'red' ) . "\n" | ||||
| } | ||||
|  | ||||
| $log->info( $showno, "Collecting $field from JSON" ); | ||||
|  | ||||
| _debug( $DEBUG > 2, Dumper($JSON_content) ); | ||||
| #_debug( $DEBUG > 2, "\$field: $field" ); | ||||
| #_debug( $DEBUG > 2, Dumper(\%fields) ); | ||||
|  | ||||
|  | ||||
| #------------------------------------------------------------------------------- | ||||
| # Get the contents of the primary JSON field. The group will all be the same, | ||||
| # as will the text versions, so we edit the primary and propagate to the | ||||
| # others. | ||||
| #------------------------------------------------------------------------------- | ||||
| $log->info( $showno, | ||||
|     "Collecting from JSON with path '$fields{$field}->{json}->[0]'" ); | ||||
|  | ||||
| # | ||||
| # Use the path in the %fields hash to get the prinmary node in the JSON hash. | ||||
| # We are using 'get_JSON' rather than going to the field directly because | ||||
| # we're hunting for different parts of the JSON structure depending on the | ||||
| # -field=NAME option and using a jq-like path stored in %fields. | ||||
| # | ||||
| $field_contents = get_JSON( $JSON_content, $fields{$field}->{json}->[0] ); | ||||
| #say( defined($field_contents) ? $field_contents : 'undefined' ); | ||||
| die colored( "No contents in field '$field'. Can't continue", 'red' ) . "\n" | ||||
|     unless ( defined($field_contents) ); | ||||
|  | ||||
| $log->info( $showno, "Contents of field: $field_contents" ); | ||||
| $before = $field_contents; | ||||
|  | ||||
| # | ||||
| # Run the editor on what we collected | ||||
| # | ||||
| if ( $field eq 'tags' ) { | ||||
|     $field_contents | ||||
|         = check_field( $field, run_editor($field_contents), 200, qr{(\n)} ); | ||||
| } | ||||
| elsif ( $field eq 'title' ) { | ||||
|     $field_contents | ||||
|         = check_field( $field, run_editor($field_contents), 100, qr{(\n)} ); | ||||
| } | ||||
| elsif ( $field eq 'summary' ) { | ||||
|     $field_contents | ||||
|         = check_field( $field, run_editor($field_contents), 100, qr{(\n)} ); | ||||
| } | ||||
|  | ||||
| die colored( "Nothing was changed. Exiting", 'red' ) . "\n" | ||||
|     if ( $field_contents eq $before ); | ||||
|  | ||||
| $log->info( $showno, "New contents of field: $field_contents" ); | ||||
|  | ||||
| #------------------------------------------------------------------------------- | ||||
| # Load the text version of the metadata | ||||
| # NOTE: 2022-12-20 - stopped modifying the shownotes.txt file | ||||
| #------------------------------------------------------------------------------- | ||||
| #open( $fh, '<:encoding(UTF-8)', $txtfile ); | ||||
| #@txtbuffer = <$fh>; | ||||
| #close($fh); | ||||
|  | ||||
| #------------------------------------------------------------------------------- | ||||
| # Make the changes to all the relevant points in the two data structures. | ||||
| # NOTE: 2022-12-20 - stopped modifying the shownotes.txt file | ||||
| #------------------------------------------------------------------------------- | ||||
| put_JSON( $JSON_content, $fields{$field}->{json}->[0], $field_contents ); | ||||
| put_JSON( $JSON_content, $fields{$field}->{json}->[1], $field_contents ); | ||||
| #_debug( $DEBUG > 1, Dumper($JSON_content) ); | ||||
|  | ||||
| $log->info( $showno, "Updated JSON '$field' fields" ); | ||||
|  | ||||
| #@txtbuffer = update_txt( \@txtbuffer, $fields{$field}->{txt}->{regex}, | ||||
| #    $fields{$field}->{txt}->{label} . ":\t$field_contents\n" ); | ||||
| #_debug( $DEBUG > 1, "Text: " . Dumper( \@txtbuffer ) ); | ||||
|  | ||||
| #$log->info( $showno, "Updated text '$field' fields" ); | ||||
|  | ||||
| #------------------------------------------------------------------------------- | ||||
| # Turn the data structures back into files, backing up the originals and | ||||
| # writing the new. | ||||
| #------------------------------------------------------------------------------- | ||||
| unless ( -e $jsonfile_bk ) { | ||||
|     copy ($jsonfile, $jsonfile_bk) or die "Unable to backup $jsonfile\n"; | ||||
|     $log->info( $showno, "JSON backup created" ); | ||||
| } | ||||
| $json_text = encode_json($JSON_content); | ||||
| write_text($jsonfile,$json_text); | ||||
|  | ||||
| $log->info( $showno, "JSON file updated" ); | ||||
|  | ||||
| #unless ( -e $txtfile_bk ) { | ||||
| #    copy ($txtfile, $txtfile_bk) or die "Unable to backup $txtfile\n"; | ||||
| #    $log->info( $showno, "Text backup created" ); | ||||
| #} | ||||
| #$txtstring = join('',@txtbuffer); | ||||
| #write_text($txtfile,$txtstring); | ||||
| # | ||||
| #$log->info( $showno, "Text file updated" ); | ||||
|  | ||||
| exit; | ||||
|  | ||||
| #===  FUNCTION  ================================================================ | ||||
| #         NAME: get_JSON | ||||
| #      PURPOSE: Traverse a data structure using dotted notation and return the | ||||
| #               value at the end point | ||||
| #   PARAMETERS: $hash           hashref to traverse | ||||
| #               $path           a path in the form of '.key1.key2.[0]' which | ||||
| #                               should walk to the key 'key1', then 'key2' | ||||
| #                               within it, and open the array expected to be | ||||
| #                               there and get element 0. | ||||
| #      RETURNS: The value found or undef | ||||
| #  DESCRIPTION: Uses 'traverse_JSON' to find the $path in the $hash, returning | ||||
| #               a pointer (reference) to it. This can then be de-referenced to | ||||
| #               return the item being referenced - unless it's undefined in | ||||
| #               which case that value is returned. Being undefined means that | ||||
| #               the path did not match the structure of the hash. | ||||
| #       THROWS: No exceptions | ||||
| #     COMMENTS: None | ||||
| #     SEE ALSO: N/A | ||||
| #=============================================================================== | ||||
| sub get_JSON { | ||||
|     my ( $hash, $path ) = @_; | ||||
|  | ||||
|     my $pointer = traverse_JSON( $hash, $path ); | ||||
|  | ||||
|     # | ||||
|     # If undef then need to return undef, not try and deref it! | ||||
|     # | ||||
|     if (defined($pointer)) { | ||||
|         return $$pointer; | ||||
|     } | ||||
|     return; | ||||
| } | ||||
|  | ||||
| #===  FUNCTION  ================================================================ | ||||
| #         NAME: put_JSON | ||||
| #      PURPOSE: Traverse a data structure using dotted notation and update the | ||||
| #               value at the end point | ||||
| #   PARAMETERS: $hash           hashref to traverse | ||||
| #               $path           a path in the form of '.key1.key2.[0]' which | ||||
| #                               should walk to the key 'key1', then 'key2' | ||||
| #                               within it, and open the array expected to be | ||||
| #                               there and rewrite element 0. | ||||
| #               $new_value      the new value to place at the point in the | ||||
| #                               hash | ||||
| #      RETURNS: The previous value if found, or undef | ||||
| #  DESCRIPTION: Uses 'traverse_JSON' to find the $path in the $hash, returning | ||||
| #               a pointer (reference) to it. This can then be de-referenced to | ||||
| #               return the item being referenced - unless it's undefined in | ||||
| #               which case that value is returned. Being undefined means that | ||||
| #               the path did not match the structure of the hash. Finally, if | ||||
| #               the reference is valid then it's used to save the contents of | ||||
| #               $new_value. | ||||
| #       THROWS: No exceptions | ||||
| #     COMMENTS: None | ||||
| #     SEE ALSO: N/A | ||||
| #=============================================================================== | ||||
| sub put_JSON { | ||||
|     my ( $hash, $path, $new_value ) = @_; | ||||
|  | ||||
|     my $pointer = traverse_JSON( $hash, $path ); | ||||
|     my $old_value; | ||||
|  | ||||
|     # | ||||
|     # If $pointer is defined then dereference it as the return value. Also, | ||||
|     # use it to write the new value. | ||||
|     # | ||||
|     if (defined($pointer)) { | ||||
|         $old_value = $$pointer; | ||||
|         $$pointer = $new_value; | ||||
|     } | ||||
|  | ||||
|     return $old_value; | ||||
| } | ||||
|  | ||||
| #===  FUNCTION  ================================================================ | ||||
| #         NAME: traverse_JSON | ||||
| #      PURPOSE: Traverse a data structure using dotted notation | ||||
| #   PARAMETERS: $hash           hashref to traverse | ||||
| #               $path           a path in the form of '.key1.key2.[0]' which | ||||
| #                               should walk to the key 'key1', then 'key2' | ||||
| #                               within it, and open the array expected to be | ||||
| #                               there and return a pointer to element 0. | ||||
| #      RETURNS: A reference to the end point of the path, or undef if not | ||||
| #               found. | ||||
| #  DESCRIPTION: Given a path like '.metadata.POST.title' (where the leading | ||||
| #               '.' is optional because it's ignored), this is used to | ||||
| #               traverse a Perl version of a JSON data structure to return | ||||
| #               a *pointer* (reference) to a node. | ||||
| # | ||||
| #               This is done by processing the path step by step and using | ||||
| #               'name' elements as hash keys to get to the next level or | ||||
| #               return a terminal hash element. We also cater for '.[0]' | ||||
| #               format path elements which means to use the zeroth member of | ||||
| #               an array. Thus, if the tags were represented as an array rather | ||||
| #               than a scalar CSV string, we'd be able to use a path like: | ||||
| #               'episode.Tags.[0]' to return the first tag. | ||||
| # | ||||
| #               The data structure traversal is performed by using a pointer | ||||
| #               to a part of it, and since nested hashes are constructed by | ||||
| #               using hashrefs as hash element values, we get back references | ||||
| #               by default. | ||||
| # | ||||
| #               Once the terminal node has been reached it may be a scalar | ||||
| #               (very likely in this application), so we make and return | ||||
| #               a reference to it so that the caller can use this reference in | ||||
| #               a standard way to return or change the contents. | ||||
| # | ||||
| #               This function is meant to be more generic than this | ||||
| #               application requires. The JSON we're dealing with here doesn't | ||||
| #               have arrays (at the moment). This description is | ||||
| #               application-specifc however! | ||||
| #       THROWS: No exceptions | ||||
| #     COMMENTS: None | ||||
| #     SEE ALSO: N/A | ||||
| #=============================================================================== | ||||
| sub traverse_JSON { | ||||
|     my ( $hash, $path ) = @_; | ||||
|  | ||||
|     my ( $pointer, $index ); | ||||
|     my @elements = split( '\.', $path ); | ||||
|  | ||||
|     # | ||||
|     # Because $hash is a hashref we can just copy it | ||||
|     # | ||||
|     $pointer = $hash; | ||||
|  | ||||
|     # | ||||
|     # Traverse the hash using the path | ||||
|     # | ||||
|     foreach my $element (@elements) { | ||||
|         next unless defined($element); | ||||
|  | ||||
|         # | ||||
|         # Plain names are keys or scalar end nodes, bracketed things are | ||||
|         # arrays (which can be scalars of course) | ||||
|         # | ||||
|         unless ( ($index) = ( $element =~ /\[([^]])\]/ ) ) { | ||||
|             # Hash key | ||||
|             if ( exists( $pointer->{$element} ) ) { | ||||
|                 if ( ref( $pointer->{$element} ) eq '' ) { | ||||
|                     # | ||||
|                     # It's not a refererence so make a reference to it | ||||
|                     # | ||||
|                     $pointer = \$pointer->{$element}; | ||||
|                 } | ||||
|                 else { | ||||
|                     # | ||||
|                     # It's a reference | ||||
|                     # | ||||
|                     $pointer = $pointer->{$element}; | ||||
|                 } | ||||
|             } | ||||
|             else { | ||||
|                 # | ||||
|                 # Doesn't exist! | ||||
|                 # | ||||
|                 return;    #undef | ||||
|             } | ||||
|         } | ||||
|         else { | ||||
|             # Array | ||||
|             if ( exists( $pointer->[$index] ) ) { | ||||
|                 if ( ref( $pointer->[$index] ) eq '' ) { | ||||
|                     # | ||||
|                     # It's not a refererence so make a reference to it | ||||
|                     # | ||||
|                     $pointer = \$pointer->[$index]; | ||||
|                 } | ||||
|                 else { | ||||
|                     # | ||||
|                     # It's a reference | ||||
|                     # | ||||
|                     $pointer = $pointer->[$index]; | ||||
|                 } | ||||
|             } | ||||
|             else { | ||||
|                 # | ||||
|                 # Doesn't exist! | ||||
|                 # | ||||
|                 return;    # undef | ||||
|             } | ||||
|         } | ||||
|     } | ||||
|     return $pointer; | ||||
| } | ||||
|  | ||||
| #===  FUNCTION  ================================================================ | ||||
| #         NAME: update_txt | ||||
| #      PURPOSE: Update the data structure from 'shownotes.txt' in the light of | ||||
| #               requested changes. | ||||
| #   PARAMETERS: $array          arrayref to the contents of the shownotes.txt | ||||
| #                               file | ||||
| #               $regex          regular expression to find the line that needs | ||||
| #                               to be changed (there's just one main one). | ||||
| #               $new_value      new value to replace the original line | ||||
| #      RETURNS: Modified array | ||||
| #  DESCRIPTION: Finds the element in the arrayref ($array) which matches the | ||||
| #               regular expression ($regex). When found it is replaced by the | ||||
| #               new value ($new_value). The modified buffer is returned as | ||||
| #               a list. Uses $result to determine the value of each line since | ||||
| #               it is not permitted to change the $_ variable in the 'map' | ||||
| #               statement. | ||||
| #       THROWS: No exceptions | ||||
| #     COMMENTS: None | ||||
| #     SEE ALSO: N/A | ||||
| #=============================================================================== | ||||
| sub update_txt { | ||||
|     my ( $array, $regex, $new_value ) = @_; | ||||
|  | ||||
|     my $result; | ||||
|     my @newbuffer | ||||
|         = map { $result = ( $_ =~ /$regex/ ? $new_value : $_ ); $result } | ||||
|         @$array; | ||||
|  | ||||
|     return @newbuffer; | ||||
| } | ||||
|  | ||||
| #===  FUNCTION  ================================================================ | ||||
| #         NAME: run_editor | ||||
| #      PURPOSE: Run an interactive vim editor on a string | ||||
| #   PARAMETERS: $string         String to edit | ||||
| #               $options        An arrayref containing options for vim | ||||
| #                               (optional) Example '+set paste'. Each option | ||||
| #                               (such as '-c startinsert') needs to be | ||||
| #                               a separate array element. | ||||
| #      RETURNS: Edited string | ||||
| #  DESCRIPTION: Makes a temporary file with File::Temp ensuring that the file | ||||
| #               is in utf8 mode. Writes the edit string to the file and invokes | ||||
| #               the 'vim' editor on it. The resulting file is then read back | ||||
| #               into a string and returned to the caller, again taking care to | ||||
| #               retain utf8 mode. | ||||
| #       THROWS: No exceptions | ||||
| #     COMMENTS: File::Slurp and UTF-8 don't go well together. Moved to | ||||
| #               File::Slurper instead | ||||
| #     SEE ALSO: N/A | ||||
| #=============================================================================== | ||||
| sub run_editor { | ||||
|     my ( $string, $options ) = @_; | ||||
|  | ||||
|     # | ||||
|     # Build an arguments array for 'system' | ||||
|     # | ||||
|     my @args; | ||||
|     push( @args, @$options ) if $options; | ||||
|  | ||||
|     # | ||||
|     # Make a temporary file | ||||
|     # | ||||
|     my $tfh = File::Temp->new; | ||||
|     binmode $tfh, ":encoding(UTF-8)"; | ||||
|     my $tfn = $tfh->filename; | ||||
|     print $tfh $string if $string; | ||||
|     $tfh->close; | ||||
|  | ||||
|     # | ||||
|     # Add the filename to the arguments | ||||
|     # | ||||
|     push( @args, $tfn ); | ||||
|  | ||||
|     die "Edit failed\n" | ||||
|         unless ( system( ( 'vim', @args ) ) == 0 ); | ||||
|  | ||||
|     return read_text($tfn); | ||||
| } | ||||
|  | ||||
| #===  FUNCTION  ================================================================ | ||||
| #         NAME: check_field | ||||
| #      PURPOSE: Checks the a field is not too long and doesn't contain certain | ||||
| #               characters | ||||
| #   PARAMETERS: $name           name of field | ||||
| #               $field          string to be checked | ||||
| #               $maxlen         maximum string length | ||||
| #               $regex          regex containing illegal characters to be removed | ||||
| #      RETURNS: The input string truncated and with any illegal characters | ||||
| #               removed. | ||||
| #  DESCRIPTION: Runs a substitution on the string then truncates the result if | ||||
| #               it is too long. | ||||
| #       THROWS: No exceptions | ||||
| #     COMMENTS: None | ||||
| #     SEE ALSO: N/A | ||||
| #=============================================================================== | ||||
| sub check_field { | ||||
|     my ( $name, $field, $maxlen, $regex ) = @_; | ||||
|  | ||||
|     return unless $field; | ||||
|  | ||||
|     $field =~ s/$regex//g; | ||||
|     if ( length($field) > $maxlen ) { | ||||
|         warn "Field '$name' too long (" | ||||
|             . length($field) | ||||
|             . "); truncated to " | ||||
|             . $maxlen . "\n"; | ||||
|         $field = substr( $field, 0, $maxlen ); | ||||
|     } | ||||
|     return $field; | ||||
| } | ||||
|  | ||||
| #===  FUNCTION  ================================================================ | ||||
| #         NAME: coalesce | ||||
| #      PURPOSE: To find the first defined argument and return it | ||||
| #   PARAMETERS: Arbitrary number of arguments | ||||
| #      RETURNS: The first defined argument or undef if there are none | ||||
| #  DESCRIPTION: | ||||
| #       THROWS: No exceptions | ||||
| #     COMMENTS: None | ||||
| #     SEE ALSO: N/A | ||||
| #=============================================================================== | ||||
| sub coalesce { | ||||
|     foreach (@_) { | ||||
|         return $_ if defined($_); | ||||
|     } | ||||
|     return undef;    ## no critic | ||||
| } | ||||
|  | ||||
| #===  FUNCTION  ================================================================ | ||||
| #         NAME: _debug | ||||
| #      PURPOSE: Prints debug reports | ||||
| #   PARAMETERS: $active         Boolean: 1 for print, 0 for no print | ||||
| #               $message        Message to print | ||||
| #      RETURNS: Nothing | ||||
| #  DESCRIPTION: Outputs a message if $active is true. It removes any trailing | ||||
| #               newline and then adds one in the 'print' to the caller doesn't | ||||
| #               have to bother. Prepends the message with 'D> ' to show it's | ||||
| #               a debug message. | ||||
| #       THROWS: No exceptions | ||||
| #     COMMENTS: None | ||||
| #     SEE ALSO: N/A | ||||
| #=============================================================================== | ||||
| sub _debug { | ||||
|     my ( $active, $message ) = @_; | ||||
|  | ||||
|     chomp($message); | ||||
|     print STDERR "D> $message\n" if $active; | ||||
| } | ||||
|  | ||||
| #===  FUNCTION  ================================================================ | ||||
| #         NAME: Options | ||||
| #      PURPOSE: Processes command-line options | ||||
| #   PARAMETERS: $optref     Hash reference to hold the options | ||||
| #      RETURNS: Undef | ||||
| #  DESCRIPTION: | ||||
| #       THROWS: no exceptions | ||||
| #     COMMENTS: none | ||||
| #     SEE ALSO: n/a | ||||
| #=============================================================================== | ||||
| sub Options { | ||||
|     my ($optref) = @_; | ||||
|  | ||||
|     my @options = ( | ||||
|         "help",      "documentation|manpage", | ||||
|         "debug=i",   "field=s", | ||||
|         "episode=i", "test_dir=s", | ||||
|     ); | ||||
|  | ||||
|     if ( !GetOptions( $optref, @options ) ) { | ||||
|         pod2usage( | ||||
|             -msg     => "$PROG version $VERSION\n", | ||||
|             -verbose => 0, | ||||
|             -exitval => 1 | ||||
|         ); | ||||
|     } | ||||
|  | ||||
|     return; | ||||
| } | ||||
|  | ||||
| __END__ | ||||
|  | ||||
| #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% | ||||
| #  Application Documentation | ||||
| #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% | ||||
| #{{{ | ||||
|  | ||||
| =head1 NAME | ||||
|  | ||||
| edit_shownotes - edit JSON and text shownote metadata | ||||
|  | ||||
| =head1 VERSION | ||||
|  | ||||
| This documentation refers to edit_shownotes version 0.0.5 | ||||
|  | ||||
| =head1 USAGE | ||||
|  | ||||
|     ./edit_shownotes [-help] [-documentation|manpage] [-debug=N] | ||||
|         [-field=FIELD] -episode=N | ||||
|  | ||||
|  | ||||
|     ./edit_shownotes -field=tags -episode=3754 | ||||
|     ./edit_shownotes -field=summary -episode=3762 \ | ||||
|         -test_dir=$PWD/tests/shownotes/hpr3762 | ||||
|  | ||||
| =head1 OPTIONS | ||||
|  | ||||
| =over 8 | ||||
|  | ||||
| =item B<-help> | ||||
|  | ||||
| Prints a brief help message describing the usage of the program, and then exits. | ||||
|  | ||||
| =item B<-manpage> or B<-documentation> | ||||
|  | ||||
| Prints the entire documentation for the script. | ||||
|  | ||||
| =item B<-field=FIELD> | ||||
|  | ||||
| This optional parameter defaults to B<-field=tags>. The only permitted fields | ||||
| are 'tags', 'title' and 'summary'. | ||||
|  | ||||
| =item B<-episode=N> | ||||
|  | ||||
| This mandatory option specifies the number of the HPR episode that is being | ||||
| parsed. It needs to be numeric even though it is often used with an 'hpr' | ||||
| prefix internally. Leading zeroes are not required (when these are | ||||
| appropriate). | ||||
|  | ||||
| =item B<-test_dir=PATH> | ||||
|  | ||||
| This option is for testing. Normally the script determines the path to the | ||||
| file(s) it will parse and update. It actually finds the field specified by the | ||||
| B<-field-FIELD> option in the JSON file B<shownotes.json> and calls the editor | ||||
| to change this, then propagates any changes to the other JSON instance and the | ||||
| one in B<shownotes.txt>. | ||||
|  | ||||
| This option has been provided to make it simpler to make copies of the files | ||||
| relating to an incoming show and use them to test changes to the script. | ||||
|  | ||||
| The current workflow expects the "live" files in | ||||
| B<$HOME/HPR/Show_Submission/shownotes/hprSHOW>, but there is another area | ||||
| where show files are placed for testing: | ||||
| B<$HOME/HPR/Show_Submission/tests/shownotes/hprSHOW>. | ||||
|  | ||||
| It is simply a matter of making a copy and of referencing the directory path | ||||
| to this option. Changes will be made to this copy and log records written, but | ||||
| these will contain the word 'TEST' to show that the script is being run in | ||||
| this mode. | ||||
|  | ||||
| =item B<-debug=N> | ||||
|  | ||||
| Causes certain debugging information to be displayed. | ||||
|  | ||||
|     0   (the default) no debug output | ||||
|     1   N/A | ||||
|     2   TBA | ||||
|     3   TBA | ||||
|  | ||||
| =back | ||||
|  | ||||
| =head1 DESCRIPTION | ||||
|  | ||||
| This script is meant to be a component in a workflow dealing with the notes | ||||
| submitted by HPR hosts with the shows they are uploading. | ||||
|  | ||||
| The data from the web form which is used by hosts submitting shows is received | ||||
| in two formats, with fixed names. | ||||
|  | ||||
| The file B<shownotes.txt> contains the form data in a label/value format, but | ||||
| also uses PHP dumps to show some of the metadata. It is no longer used by the | ||||
| current workflow, but is retained for historical reasons. | ||||
|  | ||||
| The alternative file format is JSON, which is stored in B<shownotes.json>. | ||||
| This contains the same data as the other file but in a more standardised | ||||
| format. | ||||
|  | ||||
| This script is designed to allow the editing of three specific fields in these | ||||
| two files. This is because these fields are not used in the show note | ||||
| preparation workflow (though they are referenced), but any changes can be | ||||
| propagated back to the HPR server to allow workflows there to use the | ||||
| corrected version(s). | ||||
|  | ||||
| The fields which can be edited are duplicated in the two files. One of these | ||||
| is edited, and if appropriate, is propagated to the other duplicates. This | ||||
| simplifies the editing of the text format, and the JSON format, which is not | ||||
| simple to edit in a conventional way. | ||||
|  | ||||
| =head1 DIAGNOSTICS | ||||
|  | ||||
| A list of every error and warning message that the application can generate | ||||
| (even the ones that will "never happen"), with a full explanation of each | ||||
| problem, one or more likely causes, and any suggested remedies. If the | ||||
| application generates exit status codes (e.g. under Unix) then list the exit | ||||
| status associated with each error. | ||||
|  | ||||
|  | ||||
| =head1 CONFIGURATION AND ENVIRONMENT | ||||
|  | ||||
| A full explanation of any configuration system(s) used by the application, | ||||
| including the names and locations of any configuration files, and the | ||||
| meaning of any environment variables or properties that can be set. These | ||||
| descriptions must also include details of any configuration language used | ||||
|  | ||||
|  | ||||
| =head1 DEPENDENCIES | ||||
|  | ||||
| Data::Dumper | ||||
| File::Slurper | ||||
| File::Temp | ||||
| Getopt::Long | ||||
| JSON | ||||
| Log::Handler | ||||
| Pod::Usage | ||||
| Term::ANSIColor | ||||
|  | ||||
| =head1 BUGS AND LIMITATIONS | ||||
|  | ||||
| There are no known bugs in this module. | ||||
| Please report problems to Dave Morriss (Dave.Morriss@gmail.com) | ||||
| Patches are welcome. | ||||
|  | ||||
| =head1 AUTHOR | ||||
|  | ||||
| Dave Morriss (Dave.Morriss@gmail.com) | ||||
|  | ||||
| =head1 LICENCE AND COPYRIGHT | ||||
|  | ||||
| Copyright (c) 2022 Dave Morriss (Dave.Morriss@gmail.com). All rights reserved. | ||||
|  | ||||
| This module is free software; you can redistribute it and/or | ||||
| modify it under the same terms as Perl itself. See perldoc perlartistic. | ||||
|  | ||||
| This program is distributed in the hope that it will be useful, | ||||
| but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||
| MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. | ||||
|  | ||||
| =cut | ||||
|  | ||||
| #}}} | ||||
|  | ||||
| # [zo to open fold, zc to close] | ||||
|  | ||||
| # vim: syntax=perl:ts=8:sw=4:et:ai:tw=78:fo=tcrqn21:fdm=marker | ||||
|  | ||||
		Reference in New Issue
	
	Block a user