| 
									
										
										
										
											2024-06-04 16:35:44 +01:00
										 |  |  | #!/usr/bin/env perl | 
					
						
							|  |  |  | #=============================================================================== | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | #         FILE: add_hosts_to_show | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | #        USAGE: ./add_hosts_to_show -show=N -host=H1 [-host=H2 ... -host=Hn] | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | #  DESCRIPTION: Adds one or more hosts to an existing show in the 'HPR2' | 
					
						
							|  |  |  | #               database. | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | #      OPTIONS: --- | 
					
						
							|  |  |  | # REQUIREMENTS: --- | 
					
						
							|  |  |  | #         BUGS: --- | 
					
						
							|  |  |  | #        NOTES: --- | 
					
						
							|  |  |  | #       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com | 
					
						
							|  |  |  | #      VERSION: 0.0.5 | 
					
						
							|  |  |  | #      CREATED: 2017-10-28 18:56:21 | 
					
						
							|  |  |  | #     REVISION: 2019-07-08 22:53:35 | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | #=============================================================================== | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | use 5.010; | 
					
						
							|  |  |  | use strict; | 
					
						
							|  |  |  | use warnings; | 
					
						
							|  |  |  | use utf8; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | use Getopt::Long; | 
					
						
							|  |  |  | use Pod::Usage; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | use Config::General; | 
					
						
							|  |  |  | use List::Util qw( uniqstr ); | 
					
						
							|  |  |  | use IO::Prompter; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | use DBI; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 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/Database"; | 
					
						
							|  |  |  | my $configfile = "$basedir/.hpr_pg2.cfg"; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | my ( $dbh1, $sth1, $h1, $rv1 ); | 
					
						
							|  |  |  | my ( $show_type, $show_number ); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | my %details; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | my $pfmt = "%-16s: %s\n"; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # 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 | 
					
						
							|  |  |  | #------------------------------------------------------------------------------- | 
					
						
							|  |  |  | my $DEF_DEBUG = 0; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # Process options | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | my %options; | 
					
						
							|  |  |  | Options( \%options ); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # Default help | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | pod2usage( -msg => "$PROG version $VERSION\n", -exitval => 1, -verbose => 0 ) | 
					
						
							|  |  |  |     if ( $options{'help'} ); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # The -documentation or -man option shows the full POD documentation through | 
					
						
							|  |  |  | # a pager for convenience | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | pod2usage( -msg => "$PROG version $VERSION\n", -exitval => 1, -verbose => 2 ) | 
					
						
							|  |  |  |     if ( $options{'documentation'} ); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # Collect options | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | my $DEBUG = ( defined( $options{debug} ) ? $options{debug} : $DEF_DEBUG ); | 
					
						
							|  |  |  | my $verbose   = ( defined( $options{verbose} ) ? $options{verbose} : 0 ); | 
					
						
							|  |  |  | my $prompting = ( defined( $options{prompt} )  ? $options{prompt}  : 1 ); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | my $show = $options{show}; | 
					
						
							|  |  |  | my @hosts = ( defined( $options{host} ) ? @{ $options{host} } : () ); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | #------------------------------------------------------------------------------- | 
					
						
							|  |  |  | # Basic sanity checks | 
					
						
							|  |  |  | #------------------------------------------------------------------------------- | 
					
						
							|  |  |  | pod2usage( -msg => "$PROG version $VERSION\n", -exitval => 1, -verbose => 0 ) | 
					
						
							|  |  |  |     unless ( $show and @hosts ); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # Check the show spec conforms | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | unless ( ( $show_type, $show_number ) = ( $show =~ /^(hpr|twat)?(\d+)$/ ) ) { | 
					
						
							|  |  |  |     warn "Invalid show specification: $show\n\n"; | 
					
						
							|  |  |  |     pod2usage( -msg => "$PROG version $VERSION\n", -exitval => 1, | 
					
						
							|  |  |  |         -verbose => 0 ); | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # Ensure the default show type is 'hpr' and the show number contains | 
					
						
							|  |  |  | # leading zeroes | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | $show_type = 'hpr' unless $show_type; | 
					
						
							|  |  |  | $show = sprintf( "%s%04d", $show_type, $show_number ); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # Remove host duplicates and empty strings | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | @hosts = uniqstr @hosts; | 
					
						
							|  |  |  | @hosts = grep { !/^\s*$/ } @hosts; | 
					
						
							|  |  |  | unless ( scalar(@hosts) > 0 ) { | 
					
						
							|  |  |  |     warn "No valid hosts provided\n\n"; | 
					
						
							|  |  |  |     pod2usage( -msg => "$PROG version $VERSION\n", -exitval => 1, -verbose => 0  ); | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # Debug the options and what we did with them | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | if ( $DEBUG > 2 ) { | 
					
						
							|  |  |  |     print "D> Show type:   $show_type\n"; | 
					
						
							|  |  |  |     print "D> Show number: $show_number\n"; | 
					
						
							|  |  |  |     print "D> Show key:    $show\n"; | 
					
						
							|  |  |  |     print "D> Hosts:       ", join( ", ", @hosts ), "\n"; | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | #------------------------------------------------------------------------------- | 
					
						
							|  |  |  | # Connect to the PostgreSQL database | 
					
						
							|  |  |  | #------------------------------------------------------------------------------- | 
					
						
							|  |  |  | my $dbtype = $config{database}->{type} // 'Pg'; | 
					
						
							|  |  |  | my $dbhost = $config{database}->{host} // '127.0.0.1'; | 
					
						
							|  |  |  | my $dbport = $config{database}->{port} // 5432; | 
					
						
							|  |  |  | my $dbname = $config{database}->{name}; | 
					
						
							|  |  |  | my $dbuser = $config{database}->{user}; | 
					
						
							|  |  |  | my $dbpwd  = $config{database}->{password}; | 
					
						
							|  |  |  | $dbh1 | 
					
						
							|  |  |  |     = DBI->connect( "dbi:$dbtype:host=$dbhost;database=$dbname;port=$dbport", | 
					
						
							|  |  |  |     $dbuser, $dbpwd, { PrintError => 0, AutoCommit => 1 } ) | 
					
						
							|  |  |  |     or die $DBI::errstr; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # Enable client-side UTF8 | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | $dbh1->{pg_enable_utf8} = 1; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | #------------------------------------------------------------------------------- | 
					
						
							|  |  |  | # Collect the details for the nominated show | 
					
						
							|  |  |  | #------------------------------------------------------------------------------- | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # Initialise the hash where we'll keep show and host details | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | $details{$show} = {}; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # Query to check the details of the nominated show. If the show has multiple | 
					
						
							|  |  |  | # hosts already we'll get back multiple rows. | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | $sth1 = $dbh1->prepare( | 
					
						
							|  |  |  |     q{ | 
					
						
							|  |  |  |         SELECT | 
					
						
							|  |  |  |             e.episode_id AS eid, | 
					
						
							|  |  |  |             e.episode_key, | 
					
						
							|  |  |  |             e.release_date, | 
					
						
							|  |  |  |             e.title, | 
					
						
							|  |  |  |             h.host_id AS hid, | 
					
						
							|  |  |  |             h.host | 
					
						
							|  |  |  |         FROM episodes e | 
					
						
							|  |  |  |         JOIN episodes_hosts_xref eh ON (e.episode_id = eh.episode_id) | 
					
						
							|  |  |  |         JOIN hosts h ON (h.host_id = eh.host_id) | 
					
						
							|  |  |  |         WHERE e.episode_key = ? | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | ) or die $DBI::errstr; | 
					
						
							|  |  |  | if ( $dbh1->err ) { | 
					
						
							|  |  |  |     warn $dbh1->errstr; | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # Run the query | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | $rv1 = $sth1->execute($show); | 
					
						
							|  |  |  | if ( $dbh1->err ) { | 
					
						
							|  |  |  |     die $dbh1->errstr; | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # Check the result of the query | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | $rv1 = 0 if ( $rv1 eq '0E0' ); | 
					
						
							|  |  |  | die | 
					
						
							|  |  |  |     "Problem finding show $show and associated hosts. Database inconsistency?\n" | 
					
						
							|  |  |  |     unless $rv1; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # Accumulate details in a hash using 'save_details' to remove duplicates | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | while ( $h1 = $sth1->fetchrow_hashref ) { | 
					
						
							|  |  |  |     save_details( $details{$show}, 'id',           $h1->{eid} ); | 
					
						
							|  |  |  |     save_details( $details{$show}, 'release_date', $h1->{release_date} ); | 
					
						
							|  |  |  |     save_details( $details{$show}, 'title',        $h1->{title} ); | 
					
						
							|  |  |  |     save_details( $details{$show}, 'hosts', {} ); | 
					
						
							|  |  |  |     save_details( $details{$show}->{hosts}, $h1->{host}, $h1->{hid} ); | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # Report what we collected | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | print_details( \%details, $show, $pfmt ); | 
					
						
							|  |  |  | print '-' x 80, "\n"; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | #------------------------------------------------------------------------------- | 
					
						
							|  |  |  | # Find details for the host(s) we are to add | 
					
						
							|  |  |  | #------------------------------------------------------------------------------- | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # Remove hosts who are already linked to the show. This relies on the host | 
					
						
							|  |  |  | # names being an exact match with the host details we got back for the show | 
					
						
							|  |  |  | # itself. | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | @hosts = clean_host_options( \%details, $show, \@hosts ); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # Find details of hosts to be added and save them | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | save_details( $details{$show}, 'new_hosts', find_hosts( $dbh1, \@hosts ) ); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # Remove hosts from the 'new_hosts' sub-hash if they match the hosts already | 
					
						
							|  |  |  | # linked to this show | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | clean_details( \%details, $show ); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | _debug($DEBUG > 2, Dumper(\%details)); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # Abort if we didn't find all the hosts we were given | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | die "Cannot continue - some hosts cannot be added\n" | 
					
						
							|  |  |  |     unless keys( %{ $details{$show}->{new_hosts} } ); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | # Display what we're going to do | 
					
						
							|  |  |  | # | 
					
						
							|  |  |  | print "Host(s) to be added\n"; | 
					
						
							|  |  |  | for my $host ( keys( %{ $details{$show}->{new_hosts} } ) ) { | 
					
						
							|  |  |  |     my $ptr = $details{$show}->{new_hosts}; | 
					
						
							|  |  |  |     printf $pfmt, 'Host',  $host; | 
					
						
							|  |  |  |     printf $pfmt, 'Id',    $ptr->{$host}->{id}; | 
					
						
							|  |  |  |     printf $pfmt, 'Email', $ptr->{$host}->{email}; | 
					
						
							|  |  |  |     print '-' x 10, "\n"; | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | #------------------------------------------------------------------------------- | 
					
						
							|  |  |  | # Confirm that we are to add the requested hosts(s) if 'prompting' is on, and | 
					
						
							|  |  |  | # do it! | 
					
						
							|  |  |  | #------------------------------------------------------------------------------- | 
					
						
							|  |  |  | if ($prompting) { | 
					
						
							|  |  |  |     if (prompt( | 
					
						
							|  |  |  |             -style   => 'bold', | 
					
						
							|  |  |  |             -prompt  => 'Do you wish to continue? [Y/n] ', | 
					
						
							|  |  |  |             -default => 'Y', | 
					
						
							|  |  |  |             -yes | 
					
						
							|  |  |  |         ) | 
					
						
							|  |  |  |         ) | 
					
						
							|  |  |  |     { | 
					
						
							|  |  |  |         link_hosts( $dbh1, \%details, $show, $verbose ); | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  |     else { | 
					
						
							|  |  |  |         print "No hosts added\n" if ( $verbose > 0 ); | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | else { | 
					
						
							|  |  |  |     link_hosts( $dbh1, \%details, $show, $verbose ); | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | exit; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | #===  FUNCTION  ================================================================ | 
					
						
							|  |  |  | #         NAME: clean_details | 
					
						
							|  |  |  | #      PURPOSE: Check the hosts in the %details hash. If any of the hosts who | 
					
						
							|  |  |  | #               are already linked to the show are in the list of new hosts to | 
					
						
							|  |  |  | #               add, remove them. | 
					
						
							|  |  |  | #   PARAMETERS: $details        Hashref containing details | 
					
						
							|  |  |  | #               $show           Show key | 
					
						
							|  |  |  | #      RETURNS: Nothing | 
					
						
							|  |  |  | #  DESCRIPTION: Walks through the hosts that we were asked to add. They have | 
					
						
							|  |  |  | #               been expanded by looking them up in the database and stored in | 
					
						
							|  |  |  | #               $details->{$show}->{new_hosts}. If we find them in the list of | 
					
						
							|  |  |  | #               hosts linked to this show we remove them from the new hosts | 
					
						
							|  |  |  | #               list. This may leave no new hosts of course! | 
					
						
							|  |  |  | #       THROWS: No exceptions | 
					
						
							|  |  |  | #     COMMENTS: None | 
					
						
							|  |  |  | #     SEE ALSO: N/A | 
					
						
							|  |  |  | #=============================================================================== | 
					
						
							|  |  |  | sub clean_details { | 
					
						
							|  |  |  |     my ( $details, $show ) = @_; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # | 
					
						
							|  |  |  |     # Walk through the hosts that we were asked to add. They have been | 
					
						
							|  |  |  |     # expanded by looking them up in the database. If we find them in the list | 
					
						
							|  |  |  |     # of hosts linked to this show we remove them from the new hosts list. | 
					
						
							|  |  |  |     # | 
					
						
							|  |  |  |     foreach my $new ( keys( %{ $details->{$show}->{new_hosts} } ) ) { | 
					
						
							|  |  |  |         if ( exists( $details->{$show}->{hosts}->{$new} ) ) { | 
					
						
							|  |  |  |             delete( $details->{$show}->{new_hosts}->{$new} ); | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | #===  FUNCTION  ================================================================ | 
					
						
							|  |  |  | #         NAME: link_hosts | 
					
						
							|  |  |  | #      PURPOSE: Link the requested host(s) to the nominated show | 
					
						
							|  |  |  | #   PARAMETERS: $dbh            Database handle | 
					
						
							|  |  |  | #               $details        Hashref containing details | 
					
						
							|  |  |  | #               $show           Show key | 
					
						
							|  |  |  | #               $verbose        Verbosity level | 
					
						
							|  |  |  | #      RETURNS: Nothing | 
					
						
							|  |  |  | #  DESCRIPTION: Adds new hosts to the nominated show. These are in the | 
					
						
							|  |  |  | #               sub-hash $details->{$show}->{new_hosts} as keys, so we simply | 
					
						
							|  |  |  | #               need to loop through them. All hosts have their id numbers, as | 
					
						
							|  |  |  | #               does the show itself so we have all that is needed to create | 
					
						
							|  |  |  | #               the xref row. | 
					
						
							|  |  |  | #       THROWS: No exceptions | 
					
						
							|  |  |  | #     COMMENTS: None | 
					
						
							|  |  |  | #     SEE ALSO: N/A | 
					
						
							|  |  |  | #=============================================================================== | 
					
						
							|  |  |  | sub link_hosts { | 
					
						
							|  |  |  |     my ( $dbh, $details, $show, $verbose ) = @_; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     my ( $sth, $rv, $show_id ); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     $verbose = 0 unless $verbose; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # | 
					
						
							|  |  |  |     # Query to make a link entry in the xref table | 
					
						
							|  |  |  |     # | 
					
						
							|  |  |  |     $sth = $dbh->prepare( | 
					
						
							|  |  |  |         q{ | 
					
						
							|  |  |  |             INSERT INTO episodes_hosts_xref VALUES (?,?) | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |     ); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     $show_id = $details->{$show}->{episode_id}; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # | 
					
						
							|  |  |  |     # Loop through all the hosts to be added and add them | 
					
						
							|  |  |  |     # | 
					
						
							|  |  |  |     foreach my $host ( keys( %{ $details->{$show}->{new_hosts} } ) ) { | 
					
						
							|  |  |  |         print "Adding $host to $show\n" if ( $verbose > 0 ); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |         $rv = $sth->execute( $show_id, | 
					
						
							|  |  |  |             $details->{$show}->{new_hosts}->{$host}->{host_id} ); | 
					
						
							|  |  |  |         if ( $dbh->err ) { | 
					
						
							|  |  |  |             die $dbh->errstr; | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |         $rv = 0 if ( $rv eq '0E0' ); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |         warn "Failed to link $host to $show\n" | 
					
						
							|  |  |  |             unless ( defined($rv) ); | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | #===  FUNCTION  ================================================================ | 
					
						
							|  |  |  | #         NAME: find_hosts | 
					
						
							|  |  |  | #      PURPOSE: Find the requested hosts by a variety of means | 
					
						
							|  |  |  | #   PARAMETERS: $dbh            Database handle | 
					
						
							|  |  |  | #               $hosts          Arrayref containing the hosts we want to find | 
					
						
							|  |  |  | #      RETURNS: A hash containing the host names and details | 
					
						
							|  |  |  | #  DESCRIPTION: Loops through the host names in @$hosts and looks for each one | 
					
						
							|  |  |  | #               in the 'hosts' table. If found the the local hash %hosts_found | 
					
						
							|  |  |  | #               is populated with the host details. A count of matches is | 
					
						
							|  |  |  | #               maintained during this phase. If at the end of it the count is | 
					
						
							|  |  |  | #               less than the number of elements of @$hosts then we need to | 
					
						
							|  |  |  | #               try again. A local array @missing is then populated with the | 
					
						
							|  |  |  | #               missing hosts and used in another loop using the names as regular | 
					
						
							|  |  |  | #               expressions. The counter is incremented further in this loop, | 
					
						
							|  |  |  | #               and if a host is found it is added to %hosts_found. If the | 
					
						
							|  |  |  | #               count of hosts equals the number in @$hosts the function exits | 
					
						
							|  |  |  | #               with a reference to %hosts_found, otherwise an empty hash is | 
					
						
							|  |  |  | #               returned. Failure to find any host is intended to be used by | 
					
						
							|  |  |  | #               the caller as a reason to abort the script (though maybe | 
					
						
							|  |  |  | #               further searches could be added in the future). | 
					
						
							|  |  |  | #               The regex query takes care that it also counts the number of | 
					
						
							|  |  |  | #               matches, so that if a  wildcard host name is used which | 
					
						
							|  |  |  | #               matches multiple hosts we ignore the result. That way | 
					
						
							|  |  |  | #               "-host='A*'" doesn't match all the hosts with an 'a' in their | 
					
						
							|  |  |  | #               name. The regex matching is case insensitive. | 
					
						
							|  |  |  | #       THROWS: No exceptions | 
					
						
							|  |  |  | #     COMMENTS: None | 
					
						
							|  |  |  | #     SEE ALSO: N/A | 
					
						
							|  |  |  | #=============================================================================== | 
					
						
							|  |  |  | sub find_hosts { | 
					
						
							|  |  |  |     my ( $dbh, $hosts ) = @_; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     my ( $sth, $h, $hcount, @found, @missing, %hosts_found ); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # | 
					
						
							|  |  |  |     # Query to find host by name using an exact match | 
					
						
							|  |  |  |     # | 
					
						
							|  |  |  |     $sth = $dbh->prepare( | 
					
						
							|  |  |  |         q{ | 
					
						
							|  |  |  |             SELECT * FROM hosts where host = ? | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  |     ) or die $DBI::errstr; | 
					
						
							|  |  |  |     if ( $dbh->err ) { | 
					
						
							|  |  |  |         warn $dbh->errstr; | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # | 
					
						
							|  |  |  |     # Loop through the host names matching exactly | 
					
						
							|  |  |  |     # | 
					
						
							|  |  |  |     $hcount = 0; | 
					
						
							|  |  |  |     for my $host (@$hosts) { | 
					
						
							|  |  |  |         $sth->execute($host); | 
					
						
							|  |  |  |         if ( $dbh->err ) { | 
					
						
							|  |  |  |             die $dbh->errstr; | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |         if ( $h = $sth->fetchrow_hashref ) { | 
					
						
							|  |  |  |             $hcount++; | 
					
						
							|  |  |  |             $hosts_found{$host} = { | 
					
						
							|  |  |  |                 id    => $h->{host_id}, | 
					
						
							|  |  |  |                 email => $h->{email}, | 
					
						
							|  |  |  |             }; | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # | 
					
						
							|  |  |  |     # If we didn't find any hosts have another go | 
					
						
							|  |  |  |     # | 
					
						
							|  |  |  |     if ( $hcount < scalar(@$hosts) ) { | 
					
						
							|  |  |  |         # | 
					
						
							|  |  |  |         # Isolate the hosts we didn't find (find the items in @hosts that are | 
					
						
							|  |  |  |         # not in @found) | 
					
						
							|  |  |  |         # | 
					
						
							|  |  |  |         @found = keys(%hosts_found); | 
					
						
							|  |  |  |         @missing | 
					
						
							|  |  |  |             = grep { my $item = $_; !grep( $_ eq $item, @found ) } @$hosts; | 
					
						
							|  |  |  |         #print "D> ",join(", ",@missing),"\n"; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |         # | 
					
						
							|  |  |  |         # Query to find host by name using a regex match. This one also | 
					
						
							|  |  |  |         # returns the count of hosts since if it's not 1 we don't want to | 
					
						
							|  |  |  |         # continue because the regex is too vague. TODO: Does this make sense? | 
					
						
							|  |  |  |         # | 
					
						
							|  |  |  |         $sth = $dbh->prepare( | 
					
						
							|  |  |  |             q{ | 
					
						
							|  |  |  |                 SELECT | 
					
						
							|  |  |  |                     (SELECT | 
					
						
							|  |  |  |                         count(*) AS count | 
					
						
							|  |  |  |                     FROM hosts | 
					
						
							|  |  |  |                     WHERE host ~* ?), | 
					
						
							|  |  |  |                     host_id, | 
					
						
							|  |  |  |                     host, | 
					
						
							|  |  |  |                     email | 
					
						
							|  |  |  |                 FROM hosts | 
					
						
							|  |  |  |                 WHERE host ~* ? | 
					
						
							|  |  |  |             } | 
					
						
							|  |  |  |         ) or die $DBI::errstr; | 
					
						
							|  |  |  |         if ( $dbh->err ) { | 
					
						
							|  |  |  |             warn $dbh->errstr; | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |         # | 
					
						
							|  |  |  |         # Try the regex search on all hosts we didn't find with an exact match | 
					
						
							|  |  |  |         # | 
					
						
							|  |  |  |         for my $host (@missing) { | 
					
						
							|  |  |  |             $sth->execute( $host, $host ); | 
					
						
							|  |  |  |             if ( $dbh->err ) { | 
					
						
							|  |  |  |                 die $dbh->errstr; | 
					
						
							|  |  |  |             } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |             if ( $h = $sth->fetchrow_hashref ) { | 
					
						
							|  |  |  |                 if ( $h->{count} == 1 ) { | 
					
						
							|  |  |  |                     $hcount++; | 
					
						
							|  |  |  |                     $hosts_found{ $h->{host} } = { | 
					
						
							|  |  |  |                         id    => $h->{host_id}, | 
					
						
							|  |  |  |                         email => $h->{email}, | 
					
						
							|  |  |  |                     }; | 
					
						
							|  |  |  |                 } | 
					
						
							|  |  |  |             } | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # | 
					
						
							|  |  |  |     # We didn't find everyone, so better report this | 
					
						
							|  |  |  |     # | 
					
						
							|  |  |  |     if ( $hcount < scalar(@$hosts) ) { | 
					
						
							|  |  |  |         warn "Did not find all of the nominated hosts\n"; | 
					
						
							|  |  |  |         return {}; | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     return \%hosts_found; | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | #===  FUNCTION  ================================================================ | 
					
						
							|  |  |  | #         NAME: clean_host_options | 
					
						
							|  |  |  | #      PURPOSE: Check the requested hosts (as specified in the options) | 
					
						
							|  |  |  | #               against the actual hosts linked to the show | 
					
						
							|  |  |  | #   PARAMETERS: $details        Hashref containing details | 
					
						
							|  |  |  | #               $show           Show key | 
					
						
							|  |  |  | #               $hosts          Arrayref of requested hosts | 
					
						
							|  |  |  | #      RETURNS: A list of the hosts that aren't already linked | 
					
						
							|  |  |  | #  DESCRIPTION: Places all the hosts associated with the show into an array | 
					
						
							|  |  |  | #               then compares it with the @$hosts array such that what is left | 
					
						
							|  |  |  | #               is all the hosts that do not match hosts linked to the show. | 
					
						
							| 
									
										
										
										
											2024-06-14 16:00:04 +01:00
										 |  |  | #               Of course, if any of the hosts given as options are not exact | 
					
						
							| 
									
										
										
										
											2024-06-04 16:35:44 +01:00
										 |  |  | #               matches with the names from the database (they are regexes | 
					
						
							|  |  |  | #               perhaps) they'll be regarded as different. We have to do | 
					
						
							|  |  |  | #               further processing of what's returned from querying the | 
					
						
							|  |  |  | #               database for new hosts elsewhere, but this function should | 
					
						
							|  |  |  | #               help to save some unnecessary database queries. | 
					
						
							|  |  |  | #       THROWS: No exceptions | 
					
						
							|  |  |  | #     COMMENTS: None | 
					
						
							|  |  |  | #     SEE ALSO: N/A | 
					
						
							|  |  |  | #=============================================================================== | 
					
						
							|  |  |  | sub clean_host_options { | 
					
						
							|  |  |  |     my ( $details, $show, $hosts ) = @_; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # | 
					
						
							|  |  |  |     # Collect the names of the host(s) already linked to this show | 
					
						
							|  |  |  |     # | 
					
						
							|  |  |  |     my @show_hosts = keys( %{ $details->{$show}->{hosts} } ); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     # | 
					
						
							|  |  |  |     # Return a list of the hosts that aren't in @show_hosts | 
					
						
							|  |  |  |     # | 
					
						
							|  |  |  |     return grep { my $item = $_; !grep( $_ eq $item, @show_hosts ) } @$hosts; | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | #===  FUNCTION  ================================================================ | 
					
						
							|  |  |  | #         NAME: print_details | 
					
						
							|  |  |  | #      PURPOSE: Print accumulated show details | 
					
						
							|  |  |  | #   PARAMETERS: $details        Hashref containing details | 
					
						
							|  |  |  | #               $show           Show key | 
					
						
							|  |  |  | #               $pfmt           Format string for printing | 
					
						
							|  |  |  | #      RETURNS: Nothing | 
					
						
							|  |  |  | #  DESCRIPTION: Prints the show and linked host information from the %details | 
					
						
							|  |  |  | #               hash. To be used after these details have been collected and | 
					
						
							|  |  |  | #               before the new hosts have been analysed. | 
					
						
							|  |  |  | #       THROWS: No exceptions | 
					
						
							|  |  |  | #     COMMENTS: None | 
					
						
							|  |  |  | #     SEE ALSO: N/A | 
					
						
							|  |  |  | #=============================================================================== | 
					
						
							|  |  |  | sub print_details { | 
					
						
							|  |  |  |     my ( $details, $show, $pfmt ) = @_; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     my $count = 0; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     print "Analysis of show and associated host details\n"; | 
					
						
							|  |  |  |     printf $pfmt, 'Show key', $show; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     my $ptr = $details->{$show}; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     printf $pfmt, 'Episode id',   $ptr->{episode_id}; | 
					
						
							|  |  |  |     printf $pfmt, 'Release date', $ptr->{release_date}; | 
					
						
							|  |  |  |     printf $pfmt, 'Title',        $ptr->{title}; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     foreach my $host ( keys( %{ $ptr->{hosts} } ) ) { | 
					
						
							|  |  |  |         $count++; | 
					
						
							|  |  |  |         my $ptr2 = $ptr->{hosts}; | 
					
						
							|  |  |  |         printf $pfmt, "Host $count",    $host; | 
					
						
							|  |  |  |         printf $pfmt, "Host id $count", $ptr2->{$host}; | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | #===  FUNCTION  ================================================================ | 
					
						
							|  |  |  | #         NAME: save_details | 
					
						
							|  |  |  | #      PURPOSE: Save details of the show and related hosts in a hash | 
					
						
							|  |  |  | #   PARAMETERS: $ptr            location to store into | 
					
						
							|  |  |  | #               $key            key into the hash (under $ptr) | 
					
						
							|  |  |  | #               $value          value to store | 
					
						
							|  |  |  | #      RETURNS: Nothing | 
					
						
							|  |  |  | #  DESCRIPTION: Simplifes the process of saving information in the %details | 
					
						
							|  |  |  | #               hash, skipping the saving process if there is already data | 
					
						
							|  |  |  | #               stored. This is needed because the query used to find out | 
					
						
							|  |  |  | #               about the show and its host(s) returns more than one row. We | 
					
						
							|  |  |  | #               want to make it easy to store one set of show information and | 
					
						
							|  |  |  | #               all host information. | 
					
						
							|  |  |  | #       THROWS: No exceptions | 
					
						
							|  |  |  | #     COMMENTS: None | 
					
						
							|  |  |  | #     SEE ALSO: N/A | 
					
						
							|  |  |  | #=============================================================================== | 
					
						
							|  |  |  | sub save_details { | 
					
						
							|  |  |  |     my ( $ptr, $key, $value ) = @_; | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     unless ( exists( $ptr->{$key} ) ) { | 
					
						
							|  |  |  |         $ptr->{$key} = $value; | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | #===  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: Modelled on the SQL function of the same name. It takes a list | 
					
						
							|  |  |  | #               of arguments, scans it for the first one that is not undefined | 
					
						
							|  |  |  | #               and returns it. If an argument is defined and it's an arrayref | 
					
						
							|  |  |  | #               then the referenced array is returned comma-delimited. This | 
					
						
							|  |  |  | #               allows calls such as "coalesce($var,'undef')" which returns | 
					
						
							|  |  |  | #               the value of $var if it's defined, and 'undef' if not and | 
					
						
							|  |  |  | #               doesn't break anything along the way. | 
					
						
							|  |  |  | #       THROWS: No exceptions | 
					
						
							|  |  |  | #     COMMENTS: None | 
					
						
							|  |  |  | #     SEE ALSO: N/A | 
					
						
							|  |  |  | #=============================================================================== | 
					
						
							|  |  |  | sub coalesce { | 
					
						
							|  |  |  |     foreach (@_) { | 
					
						
							|  |  |  |         if ( defined($_) ) { | 
					
						
							|  |  |  |             if ( ref($_) eq 'ARRAY' ) { | 
					
						
							|  |  |  |                 return join( ',', @{$_} ); | 
					
						
							|  |  |  |             } | 
					
						
							|  |  |  |             else { | 
					
						
							|  |  |  |                 return $_; | 
					
						
							|  |  |  |             } | 
					
						
							|  |  |  |         } | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  |     return;    # implicit undef | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | #===  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 "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|man", "debug=i", "verbose+", | 
					
						
							|  |  |  |         "show=s", "host=s@",           "prompt!", | 
					
						
							|  |  |  |     ); | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     if ( !GetOptions( $optref, @options ) ) { | 
					
						
							|  |  |  |         pod2usage( | 
					
						
							|  |  |  |             -msg     => "$PROG version $VERSION\n", | 
					
						
							|  |  |  |             -exitval => 1, | 
					
						
							|  |  |  |             -verbose => 0 | 
					
						
							|  |  |  |         ); | 
					
						
							|  |  |  |     } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     return; | 
					
						
							|  |  |  | } | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% | 
					
						
							|  |  |  | #  Application Documentation | 
					
						
							|  |  |  | #%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% | 
					
						
							|  |  |  | #{{{ | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =head1 NAME | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | add_hosts_to_show - add hosts to a pre-existing show | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =head1 VERSION | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | This documentation refers to add_hosts_to_show version 0.0.5 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =head1 USAGE | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     add_hosts_to_show -show=SHOW -host=HOST1 [-host=HOST2 ... -host=HOSTn] | 
					
						
							|  |  |  |         [-[no]prompt] [-debug=N] [-verbose] [-help] [-documentation] | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | Examples: | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     ./add_hosts_to_show -show=hpr2297 -host='Andrew Conway' | 
					
						
							|  |  |  |     ./add_hosts_to_show -show=2297 -host='Andrew Conway' | 
					
						
							|  |  |  |     ./add_hosts_to_show -show=2297 -host='Andrew Conway' -noprompt | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =head1 OPTIONS | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =over 8 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =item B<-show=SHOW> | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | This mandatory option defines the show which is to be adjusted. The argument | 
					
						
							|  |  |  | is a show designation which may consist of one of the following: | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =over 4 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =item B<hprNNNN> | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | The characters 'B<hpr>' must be followed by a show number, and this will select | 
					
						
							|  |  |  | the I<Hacker Public Radio> show with that number. | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =item B<twatNNNN> | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | The characters 'B<twat>' must be followed by a show number, and this will | 
					
						
							|  |  |  | select the I<Today with a Techie> show with that number. | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =item B<NNNN> | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | A plain number is interpreted as a I<Hacker Public Radio> show as if | 
					
						
							|  |  |  | B<hprNNNN> had been specified. | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =back | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =item B<-host=HOST> | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | This mandatory option defines a host to be added to the list of show hosts. | 
					
						
							|  |  |  | The B<HOST> part must consist of the name of the host. If the name contains | 
					
						
							|  |  |  | a space then it must be enclosed in quotes (or escaped). | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | The B<-host=HOST> option may be repeated as many times as needed. | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | The B<HOST> part may be shortened so long as it is unambiguous. The script | 
					
						
							|  |  |  | attempts an exact match on the name, but if that fails it will use the name as | 
					
						
							|  |  |  | a case insensitive regular expression match, which it will use so long as it | 
					
						
							|  |  |  | finds only one match. | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =item B<-[no]prompt> | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | Normally the script prompts to give an opportunity to cancel the process if an | 
					
						
							|  |  |  | error has been made. Specifying B<i-noprompt> turns off this feature. | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =item B<-verbose> | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | This option, which can be repeated, increases the level of verbosity for each | 
					
						
							|  |  |  | use. The levels of verbosity are: | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =over 4 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 0 - minimal reporting | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 1 - simple messages shown | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =back | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =item B<-help> | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | Prints a brief help message describing the usage of the program, and then exits. | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =item B<-documentation> or B<-man> | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | Reports full information about how to use the script and exits. | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | Since the formatting used by the POD parser used here seems faulty, an | 
					
						
							|  |  |  | alternative way to view the documentation on-screen is: | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  |     pod2man add_hosts_to_show | man -l - | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | Alternatively, to generate a PDF version use the I<pod2pdf> tool from | 
					
						
							|  |  |  | I<http://search.cpan.org/~jonallen/pod2pdf-0.42/bin/pod2pdf>. This can be | 
					
						
							|  |  |  | installed with the cpan tool as App::pod2pdf. | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =item B<-debug=N> | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | Selects a level of debugging. Debug information consists of a line or series | 
					
						
							|  |  |  | of lines prefixed with the characters 'D>': | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =over 4 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =item B<0> | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | No debug output is generated: this is the default | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =item B<3> | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | The results of analysing the options are displayed. | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | The B<%details> hash is dumped after capturing show and linked host details | 
					
						
							|  |  |  | and new host details. The hash has also been cleaned of host duplicates. | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =back | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =item B<-verbose> | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | Makes the script verbose resulting in the production of more information about | 
					
						
							|  |  |  | what it is doing. | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | The script always reports the show details, the linked host details and the | 
					
						
							|  |  |  | details of the new hosts that have been requested. It needs to do this in | 
					
						
							|  |  |  | order to produce a meaningful prompt. | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | The option may be repeated to increase the level of verbosity. The levels are: | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =over 4 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =item B<0> | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | No output is generated (apart from errors and warnings if appropriate). This | 
					
						
							|  |  |  | is the default level. | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =item B<1> | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | Once the prompt has been given the script will either report on the addition | 
					
						
							|  |  |  | of the new host(s) as it adds them iif the prompt was confirmed, or will | 
					
						
							|  |  |  | report that no host has been added if the answer to the prompt was "No". | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =back | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =back | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =head1 DESCRIPTION | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | A full description of the application and its features. | 
					
						
							|  |  |  | May include numerous subsections (i.e. =head2, =head3, etc.) | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =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 | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | A list of all the other modules that this module relies upon, including any | 
					
						
							|  |  |  | restrictions on versions, and an indication whether these required modules are | 
					
						
							|  |  |  | part of the standard Perl distribution, part of the module's distribution, | 
					
						
							|  |  |  | or must be installed separately. | 
					
						
							|  |  |  | 
 | 
					
						
							|  |  |  | =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) 2017 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 | 
					
						
							|  |  |  | 
 |