HPR/hpr-tools
5
0
Fork 0
Code Issues 1 Pull Requests Packages Projects Releases Wiki Activity
38abbcdd39
hpr-tools/PostgreSQL_Database/add_hosts_to_show

913 lines
28 KiB
Perl
Executable File
Raw Blame History

#!/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.
# Of cxourse, if any of the hosts given as options are not exact
# 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
Reference in New Issue View Git Blame Copy Permalink