forked from HPR/hpr-tools
		
	
		
			
				
	
	
		
			1266 lines
		
	
	
		
			42 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
			
		
		
	
	
			1266 lines
		
	
	
		
			42 KiB
		
	
	
	
		
			Perl
		
	
	
		
			Executable File
		
	
	
	
	
#!/usr/bin/env perl
 | 
						|
#===============================================================================
 | 
						|
#
 | 
						|
#         FILE: update_mysql_pg_2
 | 
						|
#
 | 
						|
#        USAGE: ./update_mysql_pg_2
 | 
						|
#
 | 
						|
#  DESCRIPTION: Performs updates on the PostgreSQL Database 'HPR2'.
 | 
						|
#               ** Incomplete. Do not use! **
 | 
						|
#
 | 
						|
#      OPTIONS: ---
 | 
						|
# REQUIREMENTS: ---
 | 
						|
#         BUGS: ---
 | 
						|
#        NOTES: ---
 | 
						|
#       AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
 | 
						|
#      VERSION: 0.0.2
 | 
						|
#      CREATED: 2019-05-14 12:49:26
 | 
						|
#     REVISION: 2019-10-07 15:03:06
 | 
						|
#
 | 
						|
#===============================================================================
 | 
						|
 | 
						|
use 5.010;
 | 
						|
use strict;
 | 
						|
use warnings;
 | 
						|
use utf8;
 | 
						|
 | 
						|
use Getopt::Long;
 | 
						|
use Pod::Usage;
 | 
						|
 | 
						|
use Config::General;
 | 
						|
use List::MoreUtils qw{uniq apply};
 | 
						|
 | 
						|
use Date::Manip::Delta;
 | 
						|
use DateTime;
 | 
						|
use DateTime::Format::Pg;
 | 
						|
use DateTime::Format::Duration;
 | 
						|
 | 
						|
use Text::CSV;
 | 
						|
use DBI;
 | 
						|
use SQL::Abstract;
 | 
						|
 | 
						|
use Data::Dumper;
 | 
						|
 | 
						|
#
 | 
						|
# Version number (manually incremented)
 | 
						|
#
 | 
						|
our $VERSION = '0.0.2';
 | 
						|
 | 
						|
#
 | 
						|
# Script and directory names
 | 
						|
#
 | 
						|
( my $PROG = $0 ) =~ s|.*/||mx;
 | 
						|
( my $DIR  = $0 ) =~ s|/?[^/]*$||mx;
 | 
						|
$DIR = '.' unless $DIR;
 | 
						|
 | 
						|
#-------------------------------------------------------------------------------
 | 
						|
# Declarations
 | 
						|
#-------------------------------------------------------------------------------
 | 
						|
#
 | 
						|
# Constants and other declarations
 | 
						|
#
 | 
						|
my $basedir     = "$ENV{HOME}/HPR/PostgreSQL_Database";
 | 
						|
my $configfile1 = "$basedir/.hpr_db.cfg";
 | 
						|
my $configfile2 = "$basedir/.hpr_pg2.cfg";
 | 
						|
my $database3   = "$basedir/ia.db";     # soft link
 | 
						|
 | 
						|
my $email_template  = 'host_%s@hackerpublicradio.org';
 | 
						|
my $default_licence = 'CC-BY-SA';
 | 
						|
 | 
						|
my ( $dbh1, $sth1, $h1, $rv1 );
 | 
						|
my ( $dbh2, $sth2, $h2, $rv2 );
 | 
						|
my ( $dbh3, $sth3, $h3, $rv3 );
 | 
						|
 | 
						|
my (@phase_choices);
 | 
						|
 | 
						|
my @phases = (
 | 
						|
    'episodes', 'hosts',    'eh_xref', 'series', 'es_xref', 'tags',
 | 
						|
    'comments', 'archived', 'assets',  'epilogue'
 | 
						|
);
 | 
						|
 | 
						|
my $licenses;
 | 
						|
 | 
						|
#
 | 
						|
# Shows parity between the MySQL tables and fields and the PostgreSQL ones.
 | 
						|
#
 | 
						|
# Organisation:
 | 
						|
# hash: named from the two table names
 | 
						|
#       ----
 | 
						|
#       key: '_fields'
 | 
						|
#       value: array of the MySQL field names in desired order
 | 
						|
#       ----
 | 
						|
#       key: '_MSQL'
 | 
						|
#       value: SQL to be used to query the MySQL database when scanning for
 | 
						|
#       updates
 | 
						|
#       ----
 | 
						|
#       key: '_PGSQL'
 | 
						|
#       value: SQL to be used to query the PostgreSQL database when looking
 | 
						|
#       for the record in a table corresponding to the MySQL one
 | 
						|
#       ----
 | 
						|
#       key: '_PK'
 | 
						|
#       value: arrayref containing the names of the primary key fields of the
 | 
						|
#       MySQL and PostgreSQL tables
 | 
						|
#       ----
 | 
						|
#       key: '_PGTABLE'
 | 
						|
#       value: the name of the PostgreSQL table
 | 
						|
#       ----
 | 
						|
#       key: name of MySQL field (as listed in '_fields')
 | 
						|
#       value: array of 2-4 elements
 | 
						|
#         0: name of Pg field for comparison purposes
 | 
						|
#         1: function to manipulate one field into the other, or undef if
 | 
						|
#            a straight copy
 | 
						|
#         2: name of Pg field in the table
 | 
						|
#         3: function to transform the MySQL field to the Pg one
 | 
						|
#
 | 
						|
my %table_maps = (
 | 
						|
  # --------------------------------------------------------------------------
 | 
						|
    'eps_episodes' => {
 | 
						|
        '_fields' => [
 | 
						|
            'id',      'date',  'title',    'duration',
 | 
						|
            'summary', 'notes', 'explicit', 'license',
 | 
						|
            'downloads'
 | 
						|
        ],
 | 
						|
        '_MSQL' =>
 | 
						|
#            q{SELECT * FROM eps WHERE id BETWEEN 850 AND 900},
 | 
						|
#            q{SELECT * FROM eps WHERE id BETWEEN 2501 AND 2850 ORDER BY id},
 | 
						|
#            q{SELECT * FROM eps WHERE id = 700},
 | 
						|
            q{SELECT * FROM eps WHERE status != 'reserved' ORDER BY id},
 | 
						|
        '_PGSQL' => q{
 | 
						|
            SELECT e.*,l.short_name AS license_short_name
 | 
						|
            FROM episodes e
 | 
						|
            JOIN licenses l ON e.license = l.license_id
 | 
						|
            WHERE episode_key = ?
 | 
						|
        },
 | 
						|
        '_INSERT' => q{
 | 
						|
            INSERT INTO episodes
 | 
						|
            (episode_key, release_date, title, duration, summary, notes,
 | 
						|
            explicit, license, downloads, status)
 | 
						|
            VALUES (?,?,?,?,?,?,?,?,?,'posted')
 | 
						|
        },
 | 
						|
        '_PK' => ['id','episode_key'],
 | 
						|
        '_PGTABLE' => 'episodes',
 | 
						|
        id => [
 | 
						|
            'episode_key',
 | 
						|
            sub {
 | 
						|
                return sprintf( "hpr%04d", $_[0] );
 | 
						|
            }
 | 
						|
        ],
 | 
						|
        'date'     => [ 'release_date', undef ],
 | 
						|
        'title'    => [ 'title',        undef ],
 | 
						|
        'duration' => [
 | 
						|
            'duration',
 | 
						|
            sub {
 | 
						|
                return interval( $_[0] );
 | 
						|
            }
 | 
						|
        ],
 | 
						|
        'summary'   => [ 'summary',            undef ],
 | 
						|
        'notes'     => [ 'notes',              undef ],
 | 
						|
        'explicit'  => [ 'explicit',           undef ],
 | 
						|
        'license'   => [
 | 
						|
            'license_short_name',
 | 
						|
            undef,
 | 
						|
            'license',
 | 
						|
            sub {
 | 
						|
                return $licenses->{$_[0]};
 | 
						|
            }
 | 
						|
        ],
 | 
						|
        'downloads' => [ 'downloads',          undef ],
 | 
						|
        },
 | 
						|
  # --------------------------------------------------------------------------
 | 
						|
    'hosts_hosts' => {
 | 
						|
        '_fields' => [
 | 
						|
            'hostid',  'host',        'email', 'profile',
 | 
						|
            'license', 'local_image', 'gpg',   'espeak_name'
 | 
						|
        ],
 | 
						|
        '_MSQL' =>
 | 
						|
#            q{SELECT * FROM hosts ORDER BY hostid LIMIT 30 OFFSET 269},
 | 
						|
            q{SELECT * FROM hosts WHERE hostid = 379 ORDER BY hostid},
 | 
						|
#            q{SELECT * FROM hosts ORDER BY hostid},
 | 
						|
        '_PGSQL' => q{
 | 
						|
            SELECT * FROM hosts WHERE host_id = ?
 | 
						|
        },
 | 
						|
        '_INSERT' => q{INSERT INTO hosts
 | 
						|
            (host_id, host, email, profile, license, local_image, gpg, espeak_name)
 | 
						|
            VALUES (?,?,?,?,?,?,?,?)
 | 
						|
        },
 | 
						|
        '_PK' => ['hostid','host_id'],
 | 
						|
        '_PGTABLE' => 'hosts',
 | 
						|
        'hostid'      => [ 'host_id',     undef ],
 | 
						|
        'host'        => [ 'host',        undef ],
 | 
						|
        'email'       => [ 'email',       undef ],
 | 
						|
        'profile'     => [ 'profile',     undef ],
 | 
						|
        'license'     => [ 'license',
 | 
						|
            sub {
 | 
						|
                return $licenses->{$_[0]};
 | 
						|
            }
 | 
						|
        ],
 | 
						|
        'local_image' => [ 'local_image', undef ],
 | 
						|
        'gpg'         => [ 'gpg',         undef ],
 | 
						|
        'espeak_name' => [ 'espeak_name', undef ],
 | 
						|
    },
 | 
						|
  # --------------------------------------------------------------------------
 | 
						|
'episodes_hosts_xref' => {
 | 
						|
    '_fields' => [ 'id', 'hostid' ],
 | 
						|
    '_MSQL'    =>
 | 
						|
        q{SELECT e.id,h.hostid
 | 
						|
            FROM eps e, hosts h
 | 
						|
            WHERE e.hostid = h.hostid},
 | 
						|
    '_PGSQL'   =>
 | 
						|
        q{INSERT INTO episodes_hosts_xref
 | 
						|
            SELECT e.episode_id, h.host_id
 | 
						|
            FROM episodes e, hosts h
 | 
						|
            WHERE e.episode_key = ? AND h.host_id = ?},
 | 
						|
    '_INSERT'  => q{INSERT INTO episodes_hosts_xref VALUES (?,?)},
 | 
						|
    '_PK'      => [ undef ],
 | 
						|
    '_PGTABLE' => 'episodes_hosts_xref',
 | 
						|
    },
 | 
						|
  # --------------------------------------------------------------------------
 | 
						|
    'miniseries_series' => {
 | 
						|
        '_fields' =>
 | 
						|
            [ 'id', 'name', 'description', 'private', 'image' ],
 | 
						|
        '_MSQL'       =>
 | 
						|
            q{SELECT * FROM miniseries ORDER BY id},
 | 
						|
        '_PGSQL'      => q{
 | 
						|
            SELECT * FROM series WHERE series_id = ?
 | 
						|
        },
 | 
						|
        '_INSERT' => q{INSERT INTO series VALUES (?,?,?,?,?)},
 | 
						|
        '_PK'         => [ 'id', 'series_id' ],
 | 
						|
        '_PGTABLE'    => 'series',
 | 
						|
        'id'          => [ 'series_id', undef ],
 | 
						|
        'name'        => [ 'name', undef ],
 | 
						|
        'description' => [ 'description', undef ],
 | 
						|
        'private'     => [ 'private', undef ],
 | 
						|
        'image'       => [ 'image', undef ],
 | 
						|
    },
 | 
						|
  # --------------------------------------------------------------------------
 | 
						|
    'comments_comments' => {
 | 
						|
        '_fields' => [
 | 
						|
            'id',                'eps_id',
 | 
						|
            'comment_timestamp', 'comment_author_name',
 | 
						|
            'comment_title',     'comment_text', 'last_changed'
 | 
						|
        ],
 | 
						|
        '_MSQL' =>
 | 
						|
            q{SELECT * FROM comments ORDER BY id},
 | 
						|
        '_PGSQL' => q{
 | 
						|
            SELECT
 | 
						|
                e.episode_key,
 | 
						|
                c.*
 | 
						|
            FROM comments c
 | 
						|
            JOIN episodes e USING (episode_id)
 | 
						|
            WHERE comment_id = ?
 | 
						|
        },
 | 
						|
#            (comment_id, episode_id, comment_timestamp, comment_author_name,
 | 
						|
#            comment_title, comment_text)
 | 
						|
        '_INSERT' => q{INSERT INTO comments
 | 
						|
            VALUES (?,id_in_episodes(?),?,?,?,?,?)
 | 
						|
        },
 | 
						|
        '_PRE_UPDATE' => q{
 | 
						|
            ALTER TABLE comments DISABLE TRIGGER USER
 | 
						|
        },
 | 
						|
        '_POST_UPDATE' => q{
 | 
						|
            ALTER TABLE comments ENABLE TRIGGER USER
 | 
						|
        },
 | 
						|
        '_PK'                 => [ 'id', 'comment_id' ],
 | 
						|
        '_PGTABLE'            => 'comments',
 | 
						|
        'id'                  => [ 'comment_id', undef ],
 | 
						|
        'eps_id'              => [ 'episode_key',
 | 
						|
            sub {
 | 
						|
                return sprintf( "hpr%04d", $_[0] );
 | 
						|
            }
 | 
						|
        ],
 | 
						|
        'comment_timestamp'   => [ 'comment_timestamp', undef ],
 | 
						|
        'comment_author_name' => [ 'comment_author_name', undef ],
 | 
						|
        'comment_title'       => [ 'comment_title', undef ],
 | 
						|
        'comment_text'        => [ 'comment_text', undef ],
 | 
						|
        'last_changed'        => [ 'last_changed', undef ],
 | 
						|
    },
 | 
						|
  # --------------------------------------------------------------------------
 | 
						|
);
 | 
						|
 | 
						|
#
 | 
						|
# Enable Unicode mode
 | 
						|
#
 | 
						|
binmode STDOUT, ":encoding(UTF-8)";
 | 
						|
binmode STDERR, ":encoding(UTF-8)";
 | 
						|
 | 
						|
#-------------------------------------------------------------------------------
 | 
						|
# Options and arguments
 | 
						|
#-------------------------------------------------------------------------------
 | 
						|
my $DEF_DEBUG = 0;
 | 
						|
 | 
						|
#
 | 
						|
# Process options
 | 
						|
#
 | 
						|
my %options;
 | 
						|
Options( \%options );
 | 
						|
 | 
						|
#
 | 
						|
# Default help
 | 
						|
#
 | 
						|
pod2usage( -msg => "$PROG version $VERSION\n", -exitval => 1 )
 | 
						|
    if ( $options{'help'} );
 | 
						|
 | 
						|
#
 | 
						|
# Collect options
 | 
						|
#
 | 
						|
my $DEBUG = ( defined( $options{debug} ) ? $options{debug} : $DEF_DEBUG );
 | 
						|
my $cfgfile1
 | 
						|
    = ( defined( $options{config} ) ? $options{config} : $configfile1 );
 | 
						|
my $verbose = ( defined( $options{verbose} )   ? $options{verbose}   : 0 );
 | 
						|
my $dry_run = ( defined( $options{'dry-run'} ) ? $options{'dry-run'} : 0 );
 | 
						|
 | 
						|
#
 | 
						|
# This option is a list, provided as a CSV
 | 
						|
#
 | 
						|
my $phase_choices = $options{phases};
 | 
						|
if ( defined($phase_choices) ) {
 | 
						|
    #
 | 
						|
    # We have a list which we'll parse, validate, sort, make unique and filter
 | 
						|
    #
 | 
						|
    my $lcsv = Text::CSV_XS->new( { binary => 1, } );
 | 
						|
    if ( $lcsv->parse($phase_choices) ) {
 | 
						|
        # Sort fields
 | 
						|
        @phase_choices = uniq( sort { $a cmp $b } $lcsv->fields() );
 | 
						|
        # Trim leading and trailing spaces
 | 
						|
        @phase_choices = apply { $_ =~ s/(^\s*|\s*$)// } @phase_choices;
 | 
						|
 | 
						|
        # Make a list of invalid keywords
 | 
						|
        my %tmp  = map  { $_ => 1 } @phases;
 | 
						|
        my @bad = grep { not exists $tmp{$_} } @phase_choices;
 | 
						|
 | 
						|
        # Deal with all errors
 | 
						|
        die "Invalid list; no elements\n" if scalar(@phase_choices) == 0;
 | 
						|
        die "Invalid list; too many elements\n"
 | 
						|
            if scalar(@phase_choices) > scalar(@phases);
 | 
						|
        die "Invalid list elements: ", join( ",", @bad ) . "\n"
 | 
						|
            if scalar(@bad) > 0;
 | 
						|
    }
 | 
						|
    else {
 | 
						|
        die "Failed to parse -list='$phase_choices'\n"
 | 
						|
            . $lcsv->error_diag() . "\n";
 | 
						|
    }
 | 
						|
}
 | 
						|
else {
 | 
						|
    #
 | 
						|
    # By default we do all phases
 | 
						|
    #
 | 
						|
    @phase_choices = @phases;
 | 
						|
}
 | 
						|
 | 
						|
_debug( $DEBUG > 2, Dumper(\@phase_choices) );
 | 
						|
 | 
						|
#-------------------------------------------------------------------------------
 | 
						|
# Validate the %table_maps hash
 | 
						|
#-------------------------------------------------------------------------------
 | 
						|
unless ( validate_maps(\%table_maps) ) {
 | 
						|
    warn "Hash \%table_maps is wrongly structured\n";
 | 
						|
    exit 1;
 | 
						|
}
 | 
						|
 | 
						|
#-------------------------------------------------------------------------------
 | 
						|
# Configuration file for MySQL/MariaDB - load data
 | 
						|
#-------------------------------------------------------------------------------
 | 
						|
my $conf1 = Config::General->new(
 | 
						|
    -ConfigFile      => $cfgfile1,
 | 
						|
    -InterPolateVars => 1,
 | 
						|
    -ExtendedAccess  => 1
 | 
						|
);
 | 
						|
my %config1 = $conf1->getall();
 | 
						|
 | 
						|
my $conf2 = Config::General->new(
 | 
						|
    -ConfigFile      => $configfile2,
 | 
						|
    -InterPolateVars => 1,
 | 
						|
    -ExtendedAccess  => 1
 | 
						|
);
 | 
						|
my %config2 = $conf2->getall();
 | 
						|
 | 
						|
#-------------------------------------------------------------------------------
 | 
						|
# Connect to the MariaDB database
 | 
						|
#-------------------------------------------------------------------------------
 | 
						|
my $dbtype1 = $config1{database}->{type} // 'mysql';
 | 
						|
my $dbhost1 = $config1{database}->{host} // '127.0.0.1';
 | 
						|
my $dbport1 = $config1{database}->{port} // 3306;
 | 
						|
my $dbname1 = $config1{database}->{name};
 | 
						|
my $dbuser1 = $config1{database}->{user};
 | 
						|
my $dbpwd1  = $config1{database}->{password};
 | 
						|
$dbh1
 | 
						|
    = DBI->connect( "dbi:$dbtype1:host=$dbhost1;port=$dbport1;database=$dbname1",
 | 
						|
    $dbuser1, $dbpwd1, { AutoCommit => 1 } )
 | 
						|
    or die $DBI::errstr;
 | 
						|
 | 
						|
#
 | 
						|
# Enable client-side UTF8
 | 
						|
#
 | 
						|
$dbh1->{mysql_enable_utf8} = 1;
 | 
						|
 | 
						|
#-------------------------------------------------------------------------------
 | 
						|
# Connect to the PostgreSQL database
 | 
						|
#-------------------------------------------------------------------------------
 | 
						|
my $dbtype2 = $config2{database}->{type} // 'Pg';
 | 
						|
my $dbhost2 = $config2{database}->{host} // '127.0.0.1';
 | 
						|
my $dbport2 = $config2{database}->{port} // 5432;
 | 
						|
my $dbname2 = $config2{database}->{name};
 | 
						|
my $dbuser2 = $config2{database}->{user};
 | 
						|
my $dbpwd2  = $config2{database}->{password};
 | 
						|
$dbh2 = DBI->connect( "dbi:$dbtype2:host=$dbhost2;database=$dbname2;port=$dbport2",
 | 
						|
    $dbuser2, $dbpwd2, { PrintError => 0, AutoCommit => 1 } )
 | 
						|
    or die $DBI::errstr;
 | 
						|
 | 
						|
#
 | 
						|
# Enable client-side UTF8
 | 
						|
#
 | 
						|
$dbh2->{pg_enable_utf8} = 1;
 | 
						|
 | 
						|
#-------------------------------------------------------------------------------
 | 
						|
# Connect to the SQLite database
 | 
						|
#-------------------------------------------------------------------------------
 | 
						|
$dbh3 = DBI->connect( "dbi:SQLite:dbname=$database3", "", "" );
 | 
						|
 | 
						|
#-------------------------------------------------------------------------------
 | 
						|
# Gather the licence details from the Pg database
 | 
						|
#-------------------------------------------------------------------------------
 | 
						|
$licenses = load_licenses($dbh2);
 | 
						|
 | 
						|
#
 | 
						|
# Populate the %choices hash
 | 
						|
#
 | 
						|
my %choices = map  { $_ => 1 } @phase_choices;
 | 
						|
 | 
						|
#
 | 
						|
# Perform phases in order, omitting those that are not in the list
 | 
						|
#
 | 
						|
for my $phase (@phases) {
 | 
						|
    #---------------------------------------------------------------------------
 | 
						|
    # Update from the 'eps' table to 'episodes'
 | 
						|
    #---------------------------------------------------------------------------
 | 
						|
    if ( $phase eq 'episodes' && exists( $choices{$phase} ) ) {
 | 
						|
        print "Find episode updates\n" if ($verbose);
 | 
						|
        update_table( $dbh1, $dbh2, $table_maps{'eps_episodes'}, $dry_run, $verbose );
 | 
						|
    }
 | 
						|
    #---------------------------------------------------------------------------
 | 
						|
    # Update from the 'hosts' table to 'hosts'
 | 
						|
    #---------------------------------------------------------------------------
 | 
						|
    elsif ( $phase eq 'hosts' && exists( $choices{$phase} ) ) {
 | 
						|
        print "Find host updates\n" if ( $verbose > 0 );
 | 
						|
        update_table( $dbh1, $dbh2, $table_maps{'hosts_hosts'}, $dry_run, $verbose );
 | 
						|
    }
 | 
						|
    #---------------------------------------------------------------------------
 | 
						|
    # Update the 'episodes_hosts_xref' table
 | 
						|
    #---------------------------------------------------------------------------
 | 
						|
    elsif ( $phase eq 'eh_xref' && exists( $choices{$phase} ) ) {
 | 
						|
        print "Find episode/host updates\n" if ( $verbose > 0 );
 | 
						|
    }
 | 
						|
    #---------------------------------------------------------------------------
 | 
						|
    # Update from the 'miniseries' table to 'series'
 | 
						|
    #---------------------------------------------------------------------------
 | 
						|
    elsif ( $phase eq 'series' && exists( $choices{$phase} ) ) {
 | 
						|
        print "Find series updates\n" if ( $verbose > 0 );
 | 
						|
        update_table( $dbh1, $dbh2, $table_maps{'miniseries_series'},
 | 
						|
            $dry_run, $verbose );
 | 
						|
    }
 | 
						|
    #---------------------------------------------------------------------------
 | 
						|
    # Update the 'episodes_series_xref' table
 | 
						|
    #---------------------------------------------------------------------------
 | 
						|
    elsif ( $phase eq 'es_xref' && exists( $choices{$phase} ) ) {
 | 
						|
        print "Find episode/series updates\n" if ( $verbose > 0 );
 | 
						|
    }
 | 
						|
    #---------------------------------------------------------------------------
 | 
						|
    #  Collect and store the id numbers and tags from the MySQL 'eps' table,
 | 
						|
    #  then update the PostgreSQL tables.
 | 
						|
    #---------------------------------------------------------------------------
 | 
						|
    elsif ( $phase eq 'tags' && exists( $choices{$phase} ) ) {
 | 
						|
        print "Find tag updates\n" if ( $verbose > 0 );
 | 
						|
    }
 | 
						|
    #---------------------------------------------------------------------------
 | 
						|
    # Update from the 'comments' table to 'comments'
 | 
						|
    #---------------------------------------------------------------------------
 | 
						|
    elsif ( $phase eq 'comments' && exists( $choices{$phase} ) ) {
 | 
						|
        print "Find comment updates\n" if ( $verbose > 0 );
 | 
						|
        update_table( $dbh1, $dbh2, $table_maps{'comments_comments'},
 | 
						|
            $dry_run, $verbose );
 | 
						|
    }
 | 
						|
    #---------------------------------------------------------------------------
 | 
						|
    # Update archive-related fields the 'episodes' table from 'ia.db'
 | 
						|
    #---------------------------------------------------------------------------
 | 
						|
    elsif ( $phase eq 'archived' && exists( $choices{$phase} ) ) {
 | 
						|
        print "Find archive data updates\n" if ( $verbose > 0 );
 | 
						|
    }
 | 
						|
    #---------------------------------------------------------------------------
 | 
						|
    # Update from the 'assets' table in 'ia.db' to 'assets'
 | 
						|
    #---------------------------------------------------------------------------
 | 
						|
    elsif ( $phase eq 'assets' && exists( $choices{$phase} ) ) {
 | 
						|
        print "Find asset updates\n" if ( $verbose > 0 );
 | 
						|
    }
 | 
						|
    #---------------------------------------------------------------------------
 | 
						|
    # Perform the 'epilogue' actions
 | 
						|
    #---------------------------------------------------------------------------
 | 
						|
    elsif ( $phase eq 'epilogue' && exists( $choices{$phase} ) ) {
 | 
						|
    }
 | 
						|
}
 | 
						|
 | 
						|
exit;
 | 
						|
 | 
						|
#===  FUNCTION  ================================================================
 | 
						|
#         NAME: validate_maps
 | 
						|
#      PURPOSE: Validates the hash containing the maps that drive this script
 | 
						|
#   PARAMETERS: $maps           hashref to the maps hash
 | 
						|
#               $verbose        how much to report
 | 
						|
#      RETURNS: True if the maps are valid, otherwise false
 | 
						|
#  DESCRIPTION: 
 | 
						|
#       THROWS: No exceptions
 | 
						|
#     COMMENTS: None
 | 
						|
#     SEE ALSO: N/A
 | 
						|
#===============================================================================
 | 
						|
sub validate_maps {
 | 
						|
    my ( $maps, $verbose ) = @_;
 | 
						|
 | 
						|
    return 0 unless defined($maps);
 | 
						|
 | 
						|
    foreach my $key (sort(keys(%$maps))) {
 | 
						|
        foreach my $k (qw{_fields _MSQL _PGSQL _INSERT _PK _PGTABLE}) {
 | 
						|
            unless (exists($maps->{$key}->{$k})) {
 | 
						|
                print "Missing key: %table_maps{$key}->{$k}\n";
 | 
						|
                return 0;
 | 
						|
            }
 | 
						|
        }
 | 
						|
        foreach my $k (@{$maps->{_fields}}) {
 | 
						|
            unless (defined($maps->{$key}->{$k})) {
 | 
						|
                print "Missing key: %table_maps{$key}->{$k}\n";
 | 
						|
                return 0;
 | 
						|
            }
 | 
						|
        }
 | 
						|
    }
 | 
						|
 | 
						|
    return 1;
 | 
						|
 | 
						|
}
 | 
						|
 | 
						|
#===  FUNCTION  ================================================================
 | 
						|
#         NAME: load_licenses
 | 
						|
#      PURPOSE: Loads the 'licenses' table from the Pg database
 | 
						|
#   PARAMETERS: $dbh            Handle for the Pg database
 | 
						|
#      RETURNS: A hashref containing the licence information
 | 
						|
#  DESCRIPTION: 
 | 
						|
#       THROWS: No exceptions
 | 
						|
#     COMMENTS: None
 | 
						|
#     SEE ALSO: N/A
 | 
						|
#===============================================================================
 | 
						|
sub load_licenses {
 | 
						|
    my ( $dbh ) = @_;
 | 
						|
 | 
						|
    my ( $licenses, %lic_n2id );
 | 
						|
 | 
						|
    my $sth = $dbh->prepare( q{SELECT * FROM licenses ORDER BY license_id} )
 | 
						|
        or die $DBI::errstr;
 | 
						|
    if ( $dbh->err ) {
 | 
						|
        warn $dbh->errstr;
 | 
						|
    }
 | 
						|
 | 
						|
    $sth->execute;
 | 
						|
    if ( $dbh->err ) {
 | 
						|
        warn $dbh->errstr;
 | 
						|
    }
 | 
						|
 | 
						|
    #
 | 
						|
    # Load the entire table as an arrayref of hashrefs
 | 
						|
    #
 | 
						|
    $licenses = $sth->fetchall_arrayref( {} );
 | 
						|
 | 
						|
    for my $row (@$licenses) {
 | 
						|
        $lic_n2id{$row->{short_name}} = $row->{license_id};
 | 
						|
    }
 | 
						|
 | 
						|
    return \%lic_n2id;
 | 
						|
 | 
						|
}
 | 
						|
 | 
						|
#===  FUNCTION  ================================================================
 | 
						|
#         NAME: update_table
 | 
						|
#      PURPOSE: Updates a Pg table from the corresponding MySQL table driven
 | 
						|
#               by the global hash %table_maps.
 | 
						|
#   PARAMETERS: $dbh1           Handle for the MariaDB database
 | 
						|
#               $dbh2           Handle for the Pg database
 | 
						|
#               $map            Hashref to the sub-hash in the %table_maps hash
 | 
						|
#               $dry_run        Dry run setting
 | 
						|
#               $verbose        Verbosity level
 | 
						|
#      RETURNS: 
 | 
						|
#  DESCRIPTION: There is not always a direct table to table correspondence, but
 | 
						|
#               the %table_maps entries present what is necessary to perform
 | 
						|
#               the actions.
 | 
						|
#       THROWS: No exceptions
 | 
						|
#     COMMENTS: None
 | 
						|
#     SEE ALSO: N/A
 | 
						|
#===============================================================================
 | 
						|
sub update_table {
 | 
						|
    my ( $dbh1, $dbh2, $map, $dry_run, $verbose ) = @_;
 | 
						|
 | 
						|
    my ( $sth1, $h1, $sth2, $h2, $count, $pgkey );
 | 
						|
    my ( %diffs, $diffhash );
 | 
						|
 | 
						|
    #
 | 
						|
    # The primary keys for the two tables
 | 
						|
    #
 | 
						|
    my ( $pk1, $pk2 ) = @{ $map->{'_PK'} };
 | 
						|
 | 
						|
    #
 | 
						|
    # Prepare a query to collect rows from the MySQL database
 | 
						|
    #
 | 
						|
    $sth1 = $dbh1->prepare( $map->{'_MSQL'} )
 | 
						|
        or die $DBI::errstr;
 | 
						|
    if ( $dbh1->err ) {
 | 
						|
        warn $dbh1->errstr;
 | 
						|
    }
 | 
						|
 | 
						|
    #
 | 
						|
    # Query to look up the equivalent episode in the Pg database.
 | 
						|
    # TODO: ensure there's SQL in the table before using it!
 | 
						|
    #
 | 
						|
    $sth2 = $dbh2->prepare( $map->{'_PGSQL'} )
 | 
						|
        or die $DBI::errstr;
 | 
						|
 | 
						|
    #
 | 
						|
    # Query MySQL for the nominated table
 | 
						|
    #
 | 
						|
    $sth1->execute;
 | 
						|
    if ( $dbh1->err ) {
 | 
						|
        die $dbh1->errstr;
 | 
						|
    }
 | 
						|
 | 
						|
    #
 | 
						|
    # Loop though MySQL table rows looking for changes
 | 
						|
    #
 | 
						|
    $count = 0;
 | 
						|
    while ( $h1 = $sth1->fetchrow_hashref ) {
 | 
						|
        #
 | 
						|
        # Build the search string for Pg, transforming it if there is code in
 | 
						|
        # the table to do so.
 | 
						|
        #
 | 
						|
        $pgkey = $h1->{$pk1};
 | 
						|
        if (defined($map->{$pk1}->[1])) {
 | 
						|
            if (ref($map->{$pk1}->[1]) eq 'CODE') {
 | 
						|
                $pgkey = $map->{$pk1}->[1]($h1->{$pk1});
 | 
						|
            }
 | 
						|
        }
 | 
						|
 | 
						|
        #
 | 
						|
        # Find the corresponding row in the Pg table
 | 
						|
        #
 | 
						|
        $sth2->execute($pgkey);
 | 
						|
        if ( $dbh2->err ) {
 | 
						|
            die $dbh2->errstr;
 | 
						|
        }
 | 
						|
 | 
						|
        if ( $h2 = $sth2->fetchrow_hashref ) {
 | 
						|
            #
 | 
						|
            # Found the record in Pg, so now check whether there's
 | 
						|
            # a difference, and accumulate them if found
 | 
						|
            #
 | 
						|
            print "Record found: ", $h1->{$pk1}, "\n" if ( $verbose > 1 );
 | 
						|
            $diffhash
 | 
						|
                = compare_fields( $h1, $h2, $map, $verbose );
 | 
						|
            $diffs{ $h2->{$pk2} } = $diffhash if ( defined($diffhash) );
 | 
						|
        }
 | 
						|
        else {
 | 
						|
            #
 | 
						|
            # Record was not found so now we have to add it. TODO
 | 
						|
            #
 | 
						|
            print "Record not found: ",$h1->{$pk1}, "\n" if ($verbose > 1);
 | 
						|
            add_row($dbh1, $dbh2, $map, $h1, $dry_run, $verbose );
 | 
						|
        }
 | 
						|
 | 
						|
        $count++;
 | 
						|
    }
 | 
						|
 | 
						|
    if (%diffs) {
 | 
						|
        print "Differences found: ",scalar(keys(%diffs)),"\n" if ($verbose);
 | 
						|
        _debug( $DEBUG >= 3, Dumper(\%diffs) );
 | 
						|
 | 
						|
        #
 | 
						|
        # Call a function which iterates through the keys of %diffs (in
 | 
						|
        # numerical order). For each key construct something like:
 | 
						|
        # update episodes set title = 'value1', summary = 'value2' where
 | 
						|
        # episode_key = 'value3';
 | 
						|
        #
 | 
						|
        update_differences( $dbh1, $dbh2, $map, $map->{'_PGTABLE'},
 | 
						|
            $map->{'_PK'}->[1], \%diffs, $dry_run, $verbose );
 | 
						|
    }
 | 
						|
 | 
						|
    return $count;
 | 
						|
}
 | 
						|
 | 
						|
#===  FUNCTION  ================================================================
 | 
						|
#         NAME: compare_fields
 | 
						|
#      PURPOSE: Compares fields in a database row looking for changes
 | 
						|
#   PARAMETERS: $h1             hashref to the current row from the MySQL query
 | 
						|
#               $h2             hashref to the current row from the Pg query
 | 
						|
#               $map            hashref to the section of the table_maps hash
 | 
						|
#                               for this table update
 | 
						|
#      RETURNS: A hashref to hash of differences (or undef if none)
 | 
						|
#  DESCRIPTION:
 | 
						|
#       THROWS: No exceptions
 | 
						|
#     COMMENTS: None
 | 
						|
#     SEE ALSO: N/A
 | 
						|
#===============================================================================
 | 
						|
sub compare_fields {
 | 
						|
    my ($h1, $h2, $map, $verbose ) = @_;
 | 
						|
 | 
						|
    my (%diffs, $f1, $f2);
 | 
						|
    my $len = ($verbose * 40);
 | 
						|
    my $pk1 = $map->{_PK}->[0];
 | 
						|
 | 
						|
    my @flds = @{$map->{_fields}};
 | 
						|
    for my $fld (@flds) {
 | 
						|
        #
 | 
						|
        # Contents of field in MySQL. We force blank strings to NULL here in
 | 
						|
        # line with copy_mysql_pg_2.
 | 
						|
        #
 | 
						|
        $f1 = nullif($h1->{$fld},'^\s*$');
 | 
						|
 | 
						|
        #
 | 
						|
        # Contents of field in Pg
 | 
						|
        #
 | 
						|
        $f2 = $h2->{$map->{$fld}->[0]};
 | 
						|
 | 
						|
        #
 | 
						|
        # If there's code to transform fields then run it. Always convert the
 | 
						|
        # MySQL to the Pg form. This for building the differences, which may
 | 
						|
        # not be what we want to write to the database.
 | 
						|
        #
 | 
						|
        if (defined($map->{$fld}->[1])) {
 | 
						|
            if (ref($map->{$fld}->[1]) eq 'CODE') {
 | 
						|
                $f1 = $map->{$fld}->[1]($f1);
 | 
						|
            }
 | 
						|
        }
 | 
						|
 | 
						|
        if ($DEBUG > 2) {
 | 
						|
            printf "D> %-5s %s = %s\n",'MySQL',$fld,coalesce($f1,'[undefined]');
 | 
						|
            printf "D> %-5s %s = %s\n",'Pg',$fld,coalesce($f2,'[undefined]');
 | 
						|
        }
 | 
						|
 | 
						|
        #
 | 
						|
        # Do the fields differ?
 | 
						|
        #
 | 
						|
        if ( !equal( $f1, $f2 ) ) {
 | 
						|
            _debug( $DEBUG > 1, $h1->{$pk1} );
 | 
						|
            printf "D> Difference found: %s\n%s\n%s\n", $fld,
 | 
						|
                coalesce( trunc( $f1, $len ), '[undefined]' ),
 | 
						|
                coalesce( trunc( $f2, $len ), '[undefined]' )
 | 
						|
                if ( $DEBUG > 1 );
 | 
						|
            #
 | 
						|
            # If there are further elements in the array deal with them
 | 
						|
            #
 | 
						|
            if ( defined( $map->{$fld}->[3] ) ) {
 | 
						|
                if ( ref( $map->{$fld}->[3] ) eq 'CODE' ) {
 | 
						|
                    $f1 = $map->{$fld}->[3]($f1);
 | 
						|
                }
 | 
						|
            }
 | 
						|
            $diffs{$fld} = [ $f1, $f2 ];
 | 
						|
        }
 | 
						|
    }
 | 
						|
 | 
						|
    #
 | 
						|
    # Return any differences we found or 'undef' if nothing was found. This
 | 
						|
    # way of doing it is ugly but it works.
 | 
						|
    #
 | 
						|
    return ( scalar( keys(%diffs) ) > 0 ? \%diffs : undef );
 | 
						|
}
 | 
						|
 | 
						|
#===  FUNCTION  ================================================================
 | 
						|
#         NAME: update_differences
 | 
						|
#      PURPOSE: Updates differences in a Pg table
 | 
						|
#   PARAMETERS: $dbh1           Handle for the MariaDB database
 | 
						|
#               $dbh2           Handle for the Pg database
 | 
						|
#               $map            hashref to the section of the table_maps hash
 | 
						|
#                               for this table update
 | 
						|
#               $table          Name of table to update
 | 
						|
#               $keyfld         Name of field within $table for 'WHERE' clause
 | 
						|
#               $diffs          Hashref of a hash of differences
 | 
						|
#               $dry_run        Dry run setting
 | 
						|
#               $verbose        Verbosity level
 | 
						|
#      RETURNS: Nothing
 | 
						|
#  DESCRIPTION: 
 | 
						|
#       THROWS: No exceptions
 | 
						|
#     COMMENTS: None
 | 
						|
#     SEE ALSO: N/A
 | 
						|
#===============================================================================
 | 
						|
sub update_differences {
 | 
						|
    my ( $dbh1, $dbh2, $map, $table, $keyfld, $diffs, $dry_run, $verbose )
 | 
						|
        = @_;
 | 
						|
 | 
						|
    my ( $sql, $stmt, @bind, %data, %where, $sth2 );
 | 
						|
 | 
						|
    #
 | 
						|
    # Loop through the updates by key
 | 
						|
    #
 | 
						|
    foreach my $key ( sort( keys(%$diffs) ) ) {
 | 
						|
        #
 | 
						|
        # Build new SQL each time
 | 
						|
        #
 | 
						|
        $sql = SQL::Abstract->new;
 | 
						|
 | 
						|
        #
 | 
						|
        # Populate the %data hash from the differences, accepting the MySQL
 | 
						|
        # value (the new one). If we find an empty string we make it 'undef'
 | 
						|
        # (NULL in the database).
 | 
						|
        #
 | 
						|
        foreach my $k ( keys( %{ $diffs->{$key} } ) ) {
 | 
						|
            $data{$k} = $diffs->{$key}->{$k}->[0];
 | 
						|
        }
 | 
						|
 | 
						|
        #
 | 
						|
        # Populate the %where hash
 | 
						|
        #
 | 
						|
        %where = ( $keyfld => $key );
 | 
						|
 | 
						|
        if ( $DEBUG > 2 ) {
 | 
						|
            _debug( 1, '%data: ' . Dumper( \%data ) );
 | 
						|
            _debug( 1, '%where: ' . Dumper( \%where ) );
 | 
						|
        }
 | 
						|
 | 
						|
        #
 | 
						|
        # Build the SQL and the arguments to fill the gaps
 | 
						|
        #
 | 
						|
        ( $stmt, @bind ) = $sql->update( $table, \%data, \%where );
 | 
						|
 | 
						|
        #
 | 
						|
        # Report it or do it depending on $dry_run
 | 
						|
        #
 | 
						|
        if ($dry_run) {
 | 
						|
            printf "Not changed %s: dry run mode on\n", $key;
 | 
						|
            _debug( $DEBUG > 2, "\$stmt: $stmt" );
 | 
						|
            _debug( $DEBUG > 3, "\@bind: " . join( ', ', @bind ) );
 | 
						|
        }
 | 
						|
        else {
 | 
						|
            #
 | 
						|
            # If there's a pre-update apply it
 | 
						|
            #
 | 
						|
            if ( defined( $map->{_PRE_UPDATE} ) ) {
 | 
						|
                $dbh2->do( $map->{_PRE_UPDATE} );
 | 
						|
                if ( $dbh2->err ) {
 | 
						|
                    warn $dbh2->errstr;
 | 
						|
                }
 | 
						|
            }
 | 
						|
 | 
						|
            $sth2 = $dbh2->prepare($stmt)
 | 
						|
                or die $DBI::errstr;
 | 
						|
            if ( $dbh2->err ) {
 | 
						|
                warn $dbh2->errstr;
 | 
						|
            }
 | 
						|
            $sth2->execute(@bind);
 | 
						|
            if ( $dbh2->err ) {
 | 
						|
                warn $dbh2->errstr;
 | 
						|
            }
 | 
						|
            else {
 | 
						|
                printf "Updated recordi %s\n", $key if $verbose;
 | 
						|
            }
 | 
						|
 | 
						|
            #
 | 
						|
            # If there's a post-update apply it
 | 
						|
            #
 | 
						|
            if ( defined( $map->{_POST_UPDATE} ) ) {
 | 
						|
                $dbh2->do( $map->{_POST_UPDATE} );
 | 
						|
                if ( $dbh2->err ) {
 | 
						|
                    warn $dbh2->errstr;
 | 
						|
                }
 | 
						|
            }
 | 
						|
        }
 | 
						|
 | 
						|
        #
 | 
						|
        # Prevent data 'bleed-through'
 | 
						|
        #
 | 
						|
        undef %data;
 | 
						|
        undef %where;
 | 
						|
    }
 | 
						|
}
 | 
						|
 | 
						|
#===  FUNCTION  ================================================================
 | 
						|
#         NAME: add_row
 | 
						|
#      PURPOSE: Add a row to a table
 | 
						|
#   PARAMETERS: $dbh1           Handle for the MariaDB database
 | 
						|
#               $dbh2           Handle for the Pg database
 | 
						|
#               $map            hashref to the section of the table_maps hash
 | 
						|
#                               for this table update
 | 
						|
#               $h1             hashref to the current row from the MySQL query
 | 
						|
#               $dry_run        Dry run setting
 | 
						|
#               $verbose        Verbosity level
 | 
						|
#      RETURNS: 
 | 
						|
#  DESCRIPTION: 
 | 
						|
#       THROWS: No exceptions
 | 
						|
#     COMMENTS: None
 | 
						|
#     SEE ALSO: N/A
 | 
						|
#===============================================================================
 | 
						|
sub add_row {
 | 
						|
    my ( $dbh1, $dbh2, $map, $h1, $dry_run, $verbose ) = @_;
 | 
						|
 | 
						|
    my ( @data, $fvalue, $sth2 );
 | 
						|
 | 
						|
    my @flds = @{ $map->{_fields} };
 | 
						|
    for my $fld (@flds) {
 | 
						|
 | 
						|
        #
 | 
						|
        # Ensure empty strings become NULL values
 | 
						|
        #
 | 
						|
        $fvalue = nullif( $h1->{$fld}, '^\s*$' );
 | 
						|
 | 
						|
        #
 | 
						|
        # Run the code if any, giving precedence to the second pair of
 | 
						|
        # elements in the controlling array
 | 
						|
        #
 | 
						|
        if ( defined( $map->{$fld}->[3] ) ) {
 | 
						|
            if ( ref( $map->{$fld}->[3] ) eq 'CODE' ) {
 | 
						|
                $fvalue = $map->{$fld}->[3]($fvalue);
 | 
						|
            }
 | 
						|
        }
 | 
						|
        elsif ( defined( $map->{$fld}->[1] ) ) {
 | 
						|
            if ( ref( $map->{$fld}->[1] ) eq 'CODE' ) {
 | 
						|
                $fvalue = $map->{$fld}->[1]($fvalue);
 | 
						|
            }
 | 
						|
        }
 | 
						|
 | 
						|
        #
 | 
						|
        # Save the value for writing to the database
 | 
						|
        #
 | 
						|
        push( @data, $fvalue );
 | 
						|
    }
 | 
						|
 | 
						|
    if ($dry_run) {
 | 
						|
        printf "Not added %s, dry run mode on\n", $h1->{ $map->{'_PK'}->[0] };
 | 
						|
        _debug( $DEBUG >= 3,
 | 
						|
            join( "\n", map { coalesce( $_, '[undef]' ) } @data ) );
 | 
						|
    }
 | 
						|
    else {
 | 
						|
        $sth2 = $dbh2->prepare( $map->{'_INSERT'} )
 | 
						|
            or die $DBI::errstr;
 | 
						|
        if ( $dbh2->err ) {
 | 
						|
            warn $dbh2->errstr;
 | 
						|
        }
 | 
						|
        $sth2->execute(@data);
 | 
						|
        if ( $dbh2->err ) {
 | 
						|
            warn $dbh2->errstr;
 | 
						|
        }
 | 
						|
        else {
 | 
						|
            printf "Added record %s\n", $h1->{ $map->{'_PK'}->[0] }
 | 
						|
                if $verbose;
 | 
						|
        }
 | 
						|
    }
 | 
						|
 | 
						|
}
 | 
						|
 | 
						|
#===  FUNCTION  ================================================================
 | 
						|
#         NAME: trunc
 | 
						|
#      PURPOSE: Truncate a string to a specified length and add '...' to show
 | 
						|
#               it was truncated
 | 
						|
#   PARAMETERS: $string         the string to truncate
 | 
						|
#               $len            the length to truncate to
 | 
						|
#      RETURNS: The truncated string (if it's longer than $length)
 | 
						|
#  DESCRIPTION: 
 | 
						|
#       THROWS: No exceptions
 | 
						|
#     COMMENTS: None
 | 
						|
#     SEE ALSO: N/A
 | 
						|
#===============================================================================
 | 
						|
sub trunc {
 | 
						|
    my ( $str, $len ) = @_;
 | 
						|
 | 
						|
    return unless defined($str);
 | 
						|
    return $str if ( $len >= length($str) );
 | 
						|
    return substr( $str, 0, $len ) . '...';
 | 
						|
}
 | 
						|
 | 
						|
#===  FUNCTION  ================================================================
 | 
						|
#         NAME: interval
 | 
						|
#      PURPOSE: Convert a time in seconds to a valid 'HH:MM:SS' interval
 | 
						|
#   PARAMETERS: $time           the time to convert in seconds
 | 
						|
#      RETURNS: The interval string in the format 'HH:MM:SS' or undef
 | 
						|
#  DESCRIPTION: TODO
 | 
						|
#       THROWS: No exceptions
 | 
						|
#     COMMENTS: Adapted from a routine for generating valid PostgreSQL
 | 
						|
#               interval times. Probably could be simplified
 | 
						|
#     SEE ALSO:
 | 
						|
#===============================================================================
 | 
						|
sub interval {
 | 
						|
    my ($time) = @_;
 | 
						|
 | 
						|
    return '00:00:00' unless $time;             ## no critic
 | 
						|
 | 
						|
    my $date = Date::Manip::Delta->new;
 | 
						|
    unless ( $date->parse($time) ) {
 | 
						|
        return $date->printf("%02hv:%02mv:%02sv");
 | 
						|
    }
 | 
						|
    else {
 | 
						|
        warn "Invalid time $time\n";
 | 
						|
        return undef;                           ## no critic
 | 
						|
    }
 | 
						|
 | 
						|
}
 | 
						|
 | 
						|
#===  FUNCTION  ================================================================
 | 
						|
#         NAME: default_email
 | 
						|
#      PURPOSE: Make a default email address for hosts with none
 | 
						|
#   PARAMETERS: $email          Original email address
 | 
						|
#               $regex          Regular expression to check the email against
 | 
						|
#               $template       Template for building the default
 | 
						|
#               $hostid         Host id number to use in the default
 | 
						|
#      RETURNS: The email address to be used
 | 
						|
#  DESCRIPTION: If the email address matches a regular expression then
 | 
						|
#               generate a default from the template and the host id,
 | 
						|
#               otherwise just return the address untouched.
 | 
						|
#       THROWS: No exceptions
 | 
						|
#     COMMENTS: None
 | 
						|
#     SEE ALSO: N/A
 | 
						|
#===============================================================================
 | 
						|
sub default_email {
 | 
						|
    my ( $email, $regex, $template, $hostid ) = @_;
 | 
						|
 | 
						|
    return (
 | 
						|
        $email =~ $regex
 | 
						|
        ? sprintf( $template, $hostid )
 | 
						|
        : $email
 | 
						|
    );
 | 
						|
}
 | 
						|
 | 
						|
#===  FUNCTION  ================================================================
 | 
						|
#         NAME: equal
 | 
						|
#      PURPOSE: Compare two strings even if undefined
 | 
						|
#   PARAMETERS: $s1             The first string
 | 
						|
#               $s2             The second string
 | 
						|
#      RETURNS: True if both strings are undefined, false if one isn't
 | 
						|
#               defined, otherwise the result of comparing them.
 | 
						|
#  DESCRIPTION: Works on the principle that two undefined strings are equal,
 | 
						|
#               a defined and an undefined string are not, and otherwise they
 | 
						|
#               are equal if they are equal!
 | 
						|
#       THROWS: No exceptions
 | 
						|
#     COMMENTS: None
 | 
						|
#     SEE ALSO:
 | 
						|
#===============================================================================
 | 
						|
sub equal {
 | 
						|
    my ( $s1, $s2 ) = @_;
 | 
						|
 | 
						|
    return 1 if ( !defined($s1) && !defined($s2) );
 | 
						|
    return 0 if ( !defined($s1) || !defined($s2) );
 | 
						|
 | 
						|
    return ( $s1 eq $s2 );
 | 
						|
}
 | 
						|
 | 
						|
#===  FUNCTION  ================================================================
 | 
						|
#         NAME: nullif
 | 
						|
#      PURPOSE: Tests a value and makes it 'undef' (equivalent to NULL in the
 | 
						|
#               database) if it matches a regular expression.
 | 
						|
#   PARAMETERS: $value          Value to test
 | 
						|
#               $regex          Regular expression to match against
 | 
						|
#      RETURNS: 'undef' if the values match, otherwise the original value
 | 
						|
#  DESCRIPTION: This is very simple, just a wrapper around the test.
 | 
						|
#       THROWS: No exceptions
 | 
						|
#     COMMENTS: None
 | 
						|
#     SEE ALSO: N/A
 | 
						|
#===============================================================================
 | 
						|
sub nullif {
 | 
						|
    my ( $value, $regex ) = @_;
 | 
						|
 | 
						|
    return $value unless defined($value);
 | 
						|
    return ( $value =~ $regex ? undef : $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", "config=s", "debug=i", "dry-run!", "verbose+",
 | 
						|
        "phases=s" );
 | 
						|
 | 
						|
    if ( !GetOptions( $optref, @options ) ) {
 | 
						|
        pod2usage( -msg => "$PROG version $VERSION\n", -exitval => 1 );
 | 
						|
    }
 | 
						|
 | 
						|
    return;
 | 
						|
}
 | 
						|
 | 
						|
__END__
 | 
						|
 | 
						|
 | 
						|
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 | 
						|
#  Application Documentation
 | 
						|
#%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 | 
						|
#{{{
 | 
						|
 | 
						|
=head1 NAME
 | 
						|
 | 
						|
update_mysql_pg_2 - Update the PostgreSQL database HPR2 from the live MySQL
 | 
						|
                    database or a local copy
 | 
						|
 | 
						|
=head1 VERSION
 | 
						|
 | 
						|
This documentation refers to update_mysql_pg_2 version 0.0.2
 | 
						|
 | 
						|
 | 
						|
=head1 USAGE
 | 
						|
 | 
						|
 update_mysql_pg_2 -verbose
 | 
						|
 update_mysql_pg_2 -config=.hpr_livedb.cfg -verbose
 | 
						|
 update_mysql_pg_2 -verbose \
 | 
						|
    -phase='episodes,hosts,eh_xref,series,es_xref,tags,comments,archived,assets,epilogue'
 | 
						|
 | 
						|
=head1 REQUIRED ARGUMENTS
 | 
						|
 | 
						|
A complete list of every argument that must appear on the command line.
 | 
						|
when the application  is invoked, explaining what each of them does, any
 | 
						|
restrictions on where each one may appear (i.e. flags that must appear
 | 
						|
before or after filenames), and how the various arguments and options
 | 
						|
may interact (e.g. mutual exclusions, required combinations, etc.)
 | 
						|
 | 
						|
If all of the application's arguments are optional this section
 | 
						|
may be omitted entirely.
 | 
						|
 | 
						|
 | 
						|
=head1 OPTIONS
 | 
						|
 | 
						|
A complete list of every available option with which the application
 | 
						|
can be invoked, explaining what each does, and listing any restrictions,
 | 
						|
or interactions.
 | 
						|
 | 
						|
If the application has no options this section may be omitted entirely.
 | 
						|
 | 
						|
 | 
						|
=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 INCOMPATIBILITIES
 | 
						|
 | 
						|
A list of any modules that this module cannot be used in conjunction with.
 | 
						|
This may be due to name conflicts in the interface, or competition for
 | 
						|
system or program resources, or due to internal limitations of Perl
 | 
						|
(for example, many modules that use source code filters are mutually
 | 
						|
incompatible).
 | 
						|
 | 
						|
 | 
						|
=head1 BUGS AND LIMITATIONS
 | 
						|
 | 
						|
A list of known problems with the module, together with some indication
 | 
						|
whether they are likely to be fixed in an upcoming release.
 | 
						|
 | 
						|
Also a list of restrictions on the features the module does provide:
 | 
						|
data types that cannot be handled, performance issues and the circumstances
 | 
						|
in which they may arise, practical limitations on the size of data sets,
 | 
						|
special cases that are not (yet) handled, etc.
 | 
						|
 | 
						|
The initial template usually just has:
 | 
						|
 | 
						|
There are no known bugs in this module.
 | 
						|
Please report problems to <Maintainer name(s)>  (<contact address>)
 | 
						|
Patches are welcome.
 | 
						|
 | 
						|
=head1 AUTHOR
 | 
						|
 | 
						|
<Author name(s)>  (<contact address>)
 | 
						|
 | 
						|
 | 
						|
=head1 LICENCE AND COPYRIGHT
 | 
						|
 | 
						|
Copyright (c) <year> <copyright holder> (<contact address>). All rights reserved.
 | 
						|
 | 
						|
Followed by whatever licence you wish to release it under.
 | 
						|
For Perl code that is often just:
 | 
						|
 | 
						|
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
 | 
						|
 |