HPR/hpr-tools
5
0
Fork 0
Code Issues 5 Pull Requests Packages Projects Releases Wiki Activity
a4c24296ef
hpr-tools/PostgreSQL_Database/copy_mysql_pg_2

2288 lines
69 KiB
Plaintext
Raw Normal View History

Moved project directories and files to an empty local repo
2024-06-04 15:35:44 +00:00
#!/usr/bin/env perl
#===============================================================================
#
# FILE: copy_mysql_pg_2
#
# USAGE: ./copy_mysql_pg_2
#
# DESCRIPTION: Copies HPR show data from the MariaDB database to an
# experimental PostgreSQL database (second version "HPR2")
#
# OPTIONS: ---
# REQUIREMENTS: ---
# BUGS: ---
# NOTES: ---
# AUTHOR: Dave Morriss (djm), Dave.Morriss@gmail.com
# VERSION: 0.1.5
# CREATED: 2017-10-23 19:11:48
# REVISION: 2019-06-01 16:10:23
#
#===============================================================================
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 Text::CSV;
use DBI;
use SQL::Abstract;
use Data::Dumper;
#
# Version number (manually incremented)
#
our $VERSION = '0.1.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/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 ( %eps_tags, %data );
my @phases = (
'episodes', 'hosts', 'eh_xref', 'series', 'es_xref', 'tags',
'comments', 'archived', 'assets', 'epilogue'
);
#
# 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;
}
#-------------------------------------------------------------------------------
# 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", "", "" );
my %choices = map { $_ => 1 } @phase_choices;
#
# Perform phases in order, omitting those that are not in the list
#
for my $phase (@phases) {
#---------------------------------------------------------------------------
# Copy the 'eps' table to 'episodes'
#---------------------------------------------------------------------------
if ( $phase eq 'episodes' && exists( $choices{$phase} ) ) {
print "Build episodes table\n" if ( $verbose > 0 );
if ( check_table( $dbh2, 'episodes' ) ) {
build_episodes_table( $dbh1, $dbh2, $verbose ) unless $dry_run;
}
else {
print "** Table 'episodes' is not empty\n";
}
}
#---------------------------------------------------------------------------
# Copy the 'hosts' table to 'hosts'
#---------------------------------------------------------------------------
elsif ( $phase eq 'hosts' && exists( $choices{$phase} ) ) {
print "Build hosts table\n" if ( $verbose > 0 );
if ( check_table( $dbh2, 'hosts' ) ) {
build_hosts_table( $dbh1, $dbh2, $email_template, $verbose )
unless $dry_run;
}
else {
print "** Table 'hosts' is not empty\n";
}
}
#---------------------------------------------------------------------------
# Generate the 'episodes_hosts_xref' table
#---------------------------------------------------------------------------
elsif ( $phase eq 'eh_xref' && exists( $choices{$phase} ) ) {
print "Build episodes_hosts_xref table\n" if ( $verbose > 0 );
if ( check_table( $dbh2, 'episodes_hosts_xref' ) ) {
build_episodes_hosts_xref_table( $dbh1, $dbh2, $verbose )
unless $dry_run;
}
else {
print "** Table 'episodes_hosts_xref' is not empty\n";
}
}
#---------------------------------------------------------------------------
# Copy the 'miniseries' table to 'series'
#---------------------------------------------------------------------------
elsif ( $phase eq 'series' && exists( $choices{$phase} ) ) {
print "Build series table\n" if ( $verbose > 0 );
if ( check_table( $dbh2, 'series' ) ) {
build_series_table( $dbh1, $dbh2, $verbose ) unless $dry_run;
}
else {
print "** Table 'series' is not empty\n";
}
}
#---------------------------------------------------------------------------
# Generate the 'episodes_series_xref' table
#---------------------------------------------------------------------------
elsif ( $phase eq 'es_xref' && exists( $choices{$phase} ) ) {
print "Build episodes_series_xref table\n" if ( $verbose > 0 );
if ( check_table( $dbh2, 'episodes_series_xref' ) ) {
build_episodes_series_xref_table( $dbh1, $dbh2, $verbose )
unless $dry_run;
}
else {
print "** Table 'episodes_series_xref' is not empty\n";
}
}
#---------------------------------------------------------------------------
# Collect and store the id numbers and tags from the MySQL 'eps' table,
# then add them to the PostgreSQL tables.
#---------------------------------------------------------------------------
elsif ( $phase eq 'tags' && exists( $choices{$phase} ) ) {
print "Build tags and episodes_tags_xref tables\n" if ( $verbose > 0 );
if ( check_table( $dbh2, 'tags' )
&& check_table( $dbh2, 'episodes_tags_xref' ) )
{
unless ($dry_run) {
%eps_tags = %{ collect_eps_tags( $dbh1, $verbose ) };
if (%eps_tags) {
build_tags_table( $dbh2, $verbose, \%eps_tags );
}
}
}
else {
print "** Tables 'tags' and/or 'episodes_tags_xref' are not empty\n";
}
}
#---------------------------------------------------------------------------
# Copy the 'comments' table to 'comments'
#---------------------------------------------------------------------------
elsif ( $phase eq 'comments' && exists( $choices{$phase} ) ) {
print "Build comments table\n" if ( $verbose > 0 );
if (check_table($dbh2,'comments')) {
build_comments_table( $dbh1, $dbh2, $verbose ) unless $dry_run;
}
else {
print "** Table 'comments' is not empty\n";
}
}
#---------------------------------------------------------------------------
# Fill in archive-related fields the 'episodes' table from 'ia.db'
#---------------------------------------------------------------------------
elsif ( $phase eq 'archived' && exists( $choices{$phase} ) ) {
print "Copy archive-related fields to episodes table\n" if ( $verbose > 0 );
update_episodes_table( $dbh3, $dbh2, $verbose ) unless $dry_run;
}
#---------------------------------------------------------------------------
# Copy the 'assets' table in 'ia.db' to 'assets'
#---------------------------------------------------------------------------
elsif ( $phase eq 'assets' && exists( $choices{$phase} ) ) {
print "Build assets table\n" if ( $verbose > 0 );
if (check_table($dbh2,'assets')) {
build_assets_table( $dbh3, $dbh2, $verbose ) unless $dry_run;
}
else {
print "** Table 'assets' is not empty\n";
}
}
#---------------------------------------------------------------------------
# Perform the 'epilogue' actions
#---------------------------------------------------------------------------
elsif ( $phase eq 'epilogue' && exists( $choices{$phase} ) ) {
print "Perform epilogue actions\n" if ( $verbose > 0 );
#
# Resolve the "double host" problems. We have *not* copied these
# across from the MySQL 'hosts' table, so can resolve them now.
#
resolve_double_hosts( $dbh1, $dbh2, $email_template, $default_licence,
$verbose ) unless $dry_run;
#
# Determine the first show date per host, assuming that's when they
# were added to the database
#
compute_host_date_added($dbh2) unless $dry_run;
}
}
exit;
#=== FUNCTION ================================================================
# NAME: build_episodes_table
# PURPOSE: Copy the data from the MariaDB 'eps' table to the Pg
# 'episodes' table
# PARAMETERS: $dbh1 Handle for the MariaDB database
# $dbh2 Handle for the Pg database
# $verbose Verbosity level
# RETURNS: Nothing
# DESCRIPTION:
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub build_episodes_table {
my ( $dbh1, $dbh2, $verbose ) = @_;
my $count = 0;
$count += load_twat_episodes_table( $dbh1, $dbh2, 'twat', $verbose );
$count += load_eps_table( $dbh1, $dbh2, 'hpr', $verbose );
print "Added $count records to the 'episodes' table\n"
if ( $verbose > 0 );
#
# Set the sequence to the correct value
#
alter_seq( $dbh2, 'episodes', 'episode_id', 'episode_seq' );
}
#=== FUNCTION ================================================================
# NAME: load_twat_episodes_table
# PURPOSE: Load the 'twat_episodes' table from the MariaDB database into
# the PostgreSQL 'episodes' table.
# PARAMETERS: $dbh1 Handle for the MariaDB database
# $dbh2 Handle for the Pg database
# $key_prefix String to prefix the 'episode_key' field with
# $verbose Verbosity level
# RETURNS: Number of rows added
# DESCRIPTION:
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub load_twat_episodes_table {
my ( $dbh1, $dbh2, $key_prefix, $verbose ) = @_;
my ( $sth1, $h1, $sth2, $count );
#
# Query to collect the entire 'twat_episodes' table
#
$sth1 = $dbh1->prepare('SELECT * FROM twat_episodes ORDER BY ep_num')
or die $DBI::errstr;
if ( $dbh1->err ) {
warn $dbh1->errstr;
}
#
# Query to insert into the PostgreSQL 'episodes' table
#
$sth2 = $dbh2->prepare(
q{INSERT INTO episodes
(episode_key, release_date, title, notes, explicit, license)
VALUES (?,date(to_timestamp(?)),?,?,TRUE,
id_in_licenses('CC-BY-SA'))}
) or die $DBI::errstr;
if ( $dbh2->err ) {
warn $dbh2->errstr;
}
#
# Query MariaDB for the entire 'twat_episodes' table
#
$sth1->execute;
if ( $dbh1->err ) {
die $dbh1->errstr;
}
#
# Loop though 'twat_episodes' table rows writing them to the PostgreSQL
# 'episodes' table
#
$count = 0;
while ( $h1 = $sth1->fetchrow_hashref ) {
$count++;
$sth2->execute(
sprintf( "%s%04d", $key_prefix, $h1->{ep_num} ),
$h1->{date},
coalesce( $h1->{topic}, '[undefined]' ),
coalesce( $h1->{writeup}, '<p>No notes</p>' ),
);
if ( $dbh2->err ) {
die $dbh2->errstr;
}
}
print "Copied $count records from 'twat_episodes'\n" if ( $verbose > 0 );
return $count;
}
#=== FUNCTION ================================================================
# NAME: load_eps_table
# PURPOSE: Load the 'eps' table from the MariaDB database into the
# PostgreSQL 'episodes' table.
# PARAMETERS: $dbh1 Handle for the MariaDB database
# $dbh2 Handle for the Pg database
# $key_prefix String to prefix the 'episode_key' field with
# $verbose Verbosity level
# RETURNS: Number of rows added
# DESCRIPTION:
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub load_eps_table {
my ( $dbh1, $dbh2, $key_prefix, $verbose ) = @_;
my ( $sth1, $h1, $sth2, $count );
#
# Query to collect rows from the old dfatabase
#
$sth1 = $dbh1->prepare('SELECT * FROM eps ORDER BY id')
or die $DBI::errstr;
if ( $dbh1->err ) {
warn $dbh1->errstr;
}
#
# Query to insert rows into the new database
#
$sth2 = $dbh2->prepare(
q{INSERT INTO episodes
(episode_key, release_date, title, summary, notes, explicit,
license, duration, downloads)
VALUES (?,?,?,?,?,?,id_in_licenses(?),? * '1 second'::interval,?)}
) or die $DBI::errstr;
if ( $dbh2->err ) {
warn $dbh2->errstr;
}
#
# Query MariaDB for the entire 'eps' table
#
$sth1->execute;
if ( $dbh1->err ) {
die $dbh1->errstr;
}
#
# Loop though 'eps' table rows writing them to the PostgreSQL 'episodes'
# table
#
$count = 0;
while ( $h1 = $sth1->fetchrow_hashref ) {
$count++;
$sth2->execute(
sprintf( "%s%04d", $key_prefix, $h1->{id} ),
$h1->{date},
$h1->{title},
nullif( $h1->{summary}, '^\s*$' ),
$h1->{notes},
$h1->{explicit},
$h1->{license},
$h1->{duration},
$h1->{downloads},
);
if ( $dbh2->err ) {
die $dbh2->errstr;
}
}
print "Copied $count records from 'eps'\n" if ( $verbose > 0 );
return $count;
}
#=== FUNCTION ================================================================
# NAME: build_hosts_table
# PURPOSE: Copy the data from the Mariadb 'hosts' table to the Pg 'hosts'
# table
# PARAMETERS: $dbh1 Handle for the MariaDB table
# $dbh2 Handle for the Pg database
# $template Template for building the default email
# $verbose Verbosity level
# RETURNS: Nothing
# DESCRIPTION: Copies records from one table into the other. However, some
# transformations are made along the way: blank emails and
# 'admin@hackerpublicradio.org' are converted to 'host_NNN@hpr',
# empty profiles and GPG strings are turned into NULL values,
# and licence settings are converted to the id of the licence
# in the 'licenses' table (in the database).
# The double host problem is an issue though. Since the email
# address field is unique we get errors since the double hosts
# have duplicate addresses.
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub build_hosts_table {
my ( $dbh1, $dbh2, $template, $verbose ) = @_;
my ( $sth1, $h1, $sth2, $rv, $count );
$sth1 = $dbh1->prepare('SELECT * FROM hosts') or die $DBI::errstr;
if ( $dbh1->err ) {
warn $dbh1->errstr;
}
$sth2 = $dbh2->prepare(
q{INSERT INTO hosts
(host_id, host, email, profile, license, local_image, gpg, espeak_name)
VALUES (?,?,?,?,id_in_licenses(?),?,?,?)}
) or die $DBI::errstr;
if ( $dbh2->err ) {
warn $dbh2->errstr;
}
$sth1->execute;
if ( $dbh1->err ) {
die $dbh1->errstr;
}
$count = 0;
while ( $h1 = $sth1->fetchrow_hashref ) {
#
# Ignore "double host" entries
#
if ( $h1->{host} !~ /^(.+)\s+and\s+(.+)$/ ) {
$count++;
$sth2->execute(
$h1->{hostid},
$h1->{host},
default_email(
$h1->{email}, '^(\s*|admin@hackerpublicradio.org)$',
$template, $h1->{hostid}
),
nullif( $h1->{profile}, '^\s*$' ),
$h1->{license},
$h1->{local_image},
nullif( $h1->{gpg}, '^\s*$' ),
$h1->{espeak_name},
);
if ( $dbh2->err ) {
die $dbh2->errstr;
}
}
}
print "Copied $count records\n" if ( $verbose > 0 );
#
# Set the sequence to the correct value
#
alter_seq( $dbh2, 'hosts', 'host_id', 'host_seq' );
}
#=== FUNCTION ================================================================
# NAME: build_episodes_hosts_xref_table
# PURPOSE: Generates the cross reference table by examining the 'eps' and
# 'hosts' tables in the MariaDB database.
# PARAMETERS: $dbh1 Handle for the MariaDB table
# $dbh2 Handle for the Pg database
# $verbose Verbosity level
# RETURNS: Nothing
# DESCRIPTION:
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub build_episodes_hosts_xref_table {
my ( $dbh1, $dbh2, $verbose ) = @_;
my $count = 0;
$count += link_twat_episodes( $dbh1, $dbh2, $verbose );
$count += link_hpr_episodes( $dbh1, $dbh2, $verbose );
print "Added a total of $count links\n" if ( $verbose > 0 );
}
#=== FUNCTION ================================================================
# NAME: link_twat_episodes
# PURPOSE: Generate cross reference links between TwaT episodes and hosts
# PARAMETERS: $dbh1 Handle for the MariaDB database
# $dbh2 Handle for the Pg database
# $verbose Verbosity level
# RETURNS: The count of links
# DESCRIPTION:
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub link_twat_episodes {
my ( $dbh1, $dbh2, $verbose ) = @_;
my ( $sth1, $h1, $sth2, $count, $episode_key );
#
# Query to find the TwaT episode and hostid from the old database. Use
# LEFT JOIN so we see when there's no host match.
#
$sth1 = $dbh1->prepare(
# q{SELECT t.ep_num,h.hostid
# FROM twat_episodes t, hosts h
# WHERE t.host = h.host}
q{SELECT t.ep_num, h.hostid
FROM twat_episodes t
LEFT JOIN hosts h ON (t.host = h.host)}
) or die $DBI::errstr;
if ( $dbh1->err ) {
warn $dbh1->errstr;
}
#
# Query to add a cross reference link to the new database
#
$sth2 = $dbh2->prepare(
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 = ?}
) or die $DBI::errstr;
if ( $dbh2->err ) {
warn $dbh2->errstr;
}
#
# Collect all the TwaT episodes and host id numbers
#
$sth1->execute;
if ( $dbh1->err ) {
die $dbh1->errstr;
}
#
# Loop through the result of the query, adding links to the new database.
# If the returned hostid is NULL then we don't have this host in the
# 'hosts' table and need to warn about it.
#
$count = 0;
while ( $h1 = $sth1->fetchrow_hashref ) {
$episode_key = sprintf( "twat%04d", $h1->{ep_num} );
if (defined($h1->{hostid})) {
$count++;
$sth2->execute( $episode_key, $h1->{hostid}, );
if ( $dbh2->err ) {
die $dbh2->errstr;
}
}
else {
warn "Unable to link $episode_key to a host\n";
}
}
print "Added $count links to TwaT episodes\n" if ( $verbose > 0 );
return $count;
}
#=== FUNCTION ================================================================
# NAME: link_hpr_episodes
# PURPOSE: Generate cross reference links between HPR episodes and hosts
# PARAMETERS: $dbh1 Handle for the MariaDB database
# $dbh2 Handle for the Pg database
# $verbose Verbosity level
# RETURNS: The count of links
# DESCRIPTION:
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub link_hpr_episodes {
my ( $dbh1, $dbh2, $verbose ) = @_;
my ( $sth1, $h1, $sth2, $count, $episode_key );
#
# Query to find the HPR episode and hostid from the old database
#
$sth1 = $dbh1->prepare(
q{SELECT e.id,h.hostid
FROM eps e, hosts h
WHERE e.hostid = h.hostid}
) or die $DBI::errstr;
if ( $dbh1->err ) {
warn $dbh1->errstr;
}
#
# Query to add a cross reference link to the new database
#
$sth2 = $dbh2->prepare(
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 = ?}
) or die $DBI::errstr;
if ( $dbh2->err ) {
warn $dbh2->errstr;
}
#
# Collect all the HPR episodes and host id numbers
#
$sth1->execute;
if ( $dbh1->err ) {
die $dbh1->errstr;
}
#
# Loop through the result of the query, adding links to the new database
#
$count = 0;
while ( $h1 = $sth1->fetchrow_hashref ) {
$count++;
$episode_key = sprintf( "hpr%04d", $h1->{id} );
$sth2->execute( $episode_key, $h1->{hostid}, );
if ( $dbh2->err ) {
die $dbh2->errstr;
}
}
print "Added $count links to HPR episodes\n" if ( $verbose > 0 );
return $count;
}
#=== FUNCTION ================================================================
# NAME: build_series_table
# PURPOSE: Copy the data from the Mariadb 'miniseries' table to the Pg
# 'series' table
# PARAMETERS: $dbh1 Handle for the MariaDB database
# $dbh2 Handle for the Pg database
# $verbose Verbosity level
# RETURNS: Nothing
# DESCRIPTION:
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub build_series_table {
my ( $dbh1, $dbh2, $verbose ) = @_;
my ( $sth1, $h1, $sth2, $count );
$sth1 = $dbh1->prepare('SELECT * FROM miniseries') or die $DBI::errstr;
if ( $dbh1->err ) {
warn $dbh1->errstr;
}
$sth2 = $dbh2->prepare('INSERT INTO series VALUES (?,?,?,?,?)')
or die $DBI::errstr;
if ( $dbh2->err ) {
warn $dbh2->errstr;
}
#
# Query MariaDB for the entire 'miniseries' table
#
$sth1->execute;
if ( $dbh1->err ) {
die $dbh1->errstr;
}
#
# Loop though 'miniseries' table rows writing them to the PostgreSQL
# 'series' table
#
$count = 0;
while ( $h1 = $sth1->fetchrow_hashref ) {
$count++;
$sth2->execute(
$h1->{id}, $h1->{name},
$h1->{description}, $h1->{private},
nullif( $h1->{image}, '^\s*$' ),
# $h1->{valid},
);
if ( $dbh2->err ) {
die $dbh2->errstr;
}
}
print "Copied $count records\n" if ($verbose > 0);
#
# Set the sequence to the correct value
#
alter_seq( $dbh2, 'series', 'series_id', 'series_seq' );
}
#=== FUNCTION ================================================================
# NAME: build_episodes_series_xref_table
# PURPOSE: Generates the cross reference table by examining the 'eps' and
# 'series' tables in the MariaDB database.
# PARAMETERS: $dbh1 Handle for the MariaDB table
# $dbh2 Handle for the Pg database
# $verbose Verbosity level
# RETURNS: Nothing
# DESCRIPTION:
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub build_episodes_series_xref_table {
my ( $dbh1, $dbh2, $verbose ) = @_;
my ( $sth1, $h1, $sth2, $count, $episode_key );
#
# Query to find the HPR episode and series id from the old database
#
$sth1 = $dbh1->prepare(
q{SELECT e.id AS epid, m.id AS msid
FROM eps e, miniseries m
WHERE e.series = m.id}
) or die $DBI::errstr;
if ( $dbh1->err ) {
warn $dbh1->errstr;
}
#
# Query to add a cross reference link to the new database
#
$sth2 = $dbh2->prepare(
q{INSERT INTO episodes_series_xref
SELECT e.episode_id, s.series_id
FROM episodes e, series s
WHERE e.episode_key = ? AND s.series_id = ?}
) or die $DBI::errstr;
if ( $dbh2->err ) {
warn $dbh2->errstr;
}
#
# Collect all the HPR episodes and host id numbers (no TwaT shows are in
# series)
#
$sth1->execute;
if ( $dbh1->err ) {
die $dbh1->errstr;
}
#
# Loop through the result of the query, adding links to the new database
#
$count = 0;
while ( $h1 = $sth1->fetchrow_hashref ) {
$count++;
$episode_key = sprintf( "hpr%04d", $h1->{epid} );
$sth2->execute( $episode_key, $h1->{msid} );
if ( $dbh2->err ) {
die $dbh2->errstr;
}
}
print "Added a total of $count series links\n" if ( $verbose > 0 );
}
#=== FUNCTION ================================================================
# NAME: build_tags_table
# PURPOSE: Using the data structure built from the MariaDB database
# populate the many-to-many table in the Pg database
# PARAMETERS: $dbh Handle for the Pg database
# $verbose Verbosity level
# $tag_hash Reference to a hash of episode ids and tags
# for each episode
# RETURNS: Nothing
# DESCRIPTION: Before being called the tags in the MariaDB database are
# gathered into a hash which is passed to this function as an
# argument. The hash is keyed by episode number and each value
# consists of an arrayref containing the tag strings. These tags
# are then processed to add to the PostgreSQL database.
# For each episode (in sorted order) the tag array is processed.
# If a tag already exists in the 'tags' table the tag id is
# stored for later, otherwise the tag is added to the 'tags'
# table. The tag id from either source is used to add to the
# cross reference table 'episodes_tags_xref'.
# Adding a link requires the provision of the episode key, which
# in this case will be 'hprNNNN' where 'NNNN' is a 4 digit zero
# padded number. This is converted to the episode id by
# a PostgreSQL function.
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub build_tags_table {
my ( $dbh, $verbose, $tag_hash ) = @_;
my ( $sth1, $h1, $sth2, $sth3, $rv);
my ( $tags, $tid, $episode_key, $count1, $count2 );
#
# Query to find if a tag already exists in the PostgreSQL database
#
$sth1 = $dbh->prepare(q{SELECT * FROM tags WHERE tag = ?});
#
# Query to add a new tag
#
$sth2 = $dbh->prepare(q{INSERT INTO tags (tag) VALUES(?)});
#
# Query to add a new joining row
#
$sth3 = $dbh->prepare(
q{INSERT INTO episodes_tags_xref
VALUES(id_in_episodes(?),?)}
);
$count1 = $count2 = 0;
foreach my $id ( sort { $a <=> $b } keys( %{$tag_hash} ) ) {
#
# The episode key is now more than a number
#
$episode_key = sprintf("hpr%04d", $id);
#
# Get the array of tags for this episode id
#
$tags = $tag_hash->{$id};
#
# Loop through the array of tags (using an integer so we can index the
# current tag)
#
for my $i ( 0 .. $#$tags ) {
#
# Look to see if this tag exists
#
$sth1->execute( $tags->[$i] );
if ( $dbh->err ) {
warn $dbh->errstr;
}
#
# If it's already in the table just store the id for later
# otherwise add a new entry
#
if ( $h1 = $sth1->fetchrow_hashref ) {
$tid = $h1->{tag_id};
}
else {
#
# Add the tag to 'tags'
#
$count1++;
$rv = $sth2->execute( $tags->[$i] );
if ( $dbh->err ) {
warn $dbh->errstr;
}
$rv = 0 if ( $rv eq '0E0' );
#
# Get the id number of the inserted tag
#
$tid = $dbh->last_insert_id( undef, undef, undef, undef,
{ sequence => 'tag_seq' } );
}
$count2++;
$rv = $sth3->execute( $episode_key, $tid );
if ( $dbh->err ) {
warn $dbh->errstr;
}
$rv = 0 if ( $rv eq '0E0' );
}
}
if ($verbose > 0) {
print "Added $count1 tags\n";
print "Added $count2 cross references\n";
}
}
#=== FUNCTION ================================================================
# NAME: collect_eps_tags
# PURPOSE: Collects the tags from the eps.tags field
# PARAMETERS: $dbh Database handle
# $verbose Verbosity level
# RETURNS: A reference to the hash created by collecting all the tags
# DESCRIPTION: Queries the MariaDB 'eps' table for all of the rows containing
# tags, returning the comma-separated list with the id number.
# Each CSV list is then parsed and the result turned into a hash
# keyed on the id number and containing a sorted array of tags.
# If the level of verbosity is greater than 2 the tags hash is
# dumped (ironically, as a CSV list!).
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub collect_eps_tags {
my ( $dbh, $verbose ) = @_;
my ( $status, @fields, %hash );
my ( $sth, $h );
#
# For parsing the field as CSV
#
my $csv = Text::CSV_XS->new;
#
# Query the MariaDB 'eps' table for all the id and tags
#
$sth = $dbh->prepare(
q{SELECT id,tags FROM eps
WHERE length(tags) > 0
ORDER BY id}
) or die $DBI::errstr;
if ( $dbh->err ) {
warn $dbh->errstr;
}
$sth->execute;
if ( $dbh->err ) {
warn $dbh->errstr;
}
#
# Loop through what we got
#
while ( $h = $sth->fetchrow_hashref ) {
#
# Parse the tag list
#
$status = $csv->parse( $h->{tags} );
unless ($status) {
#
# Report any errors
#
print "Parse error on episode ", $h->{id}, "\n";
print $csv->error_input(), "\n";
next;
}
@fields = $csv->fields();
next unless (@fields);
#
# Trim all tags (don't alter $_ when doing it)
#
@fields = map {
my $t = $_;
$t =~ s/(^\s+|\s+$)//g;
$t;
} @fields;
#print "$h->{id}: ",join(",",@fields),"\n";
#
# Save the id and its tags, sorted for comparison
#
$hash{ $h->{id} } = [ sort @fields ];
}
#
# Dump all id numbers and tags if the verbose level is high enough
#
if ( $verbose >= 2 ) {
print "\nTags collected from the 'eps' table\n\n";
foreach my $id ( sort { $a <=> $b } keys(%hash) ) {
printf "%04d: %s\n", $id, join( ",", @{ $hash{$id} } );
}
}
return \%hash;
}
#=== FUNCTION ================================================================
# NAME: build_comments_table
# PURPOSE: Copy the data from the Mariadb 'comments' table to the Pg
# 'comments' table
# PARAMETERS: $dbh1 Handle for the MariaDB database
# $dbh2 Handle for the Pg database
# $verbose Verbosity level
# RETURNS: Nothing
# DESCRIPTION:
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub build_comments_table {
my ( $dbh1, $dbh2, $verbose ) = @_;
my ( $sth1, $h1, $sth2, $count );
#
# Query to collect comments from the old database
#
$sth1 = $dbh1->prepare('SELECT * FROM comments') or die $DBI::errstr;
if ( $dbh1->err ) {
warn $dbh1->errstr;
}
#
# Query to insert comment data into the new database
#
$sth2 = $dbh2->prepare(
q{INSERT INTO comments VALUES (?,id_in_episodes(?),?,?,?,?,?)}
) or die $DBI::errstr;
if ( $dbh2->err ) {
warn $dbh2->errstr;
}
#
# Query MariaDB for the entire 'comments' table
#
$sth1->execute;
if ( $dbh1->err ) {
die $dbh1->errstr;
}
#
# Loop though 'comments' table rows writing them to the PostgreSQL
# 'comments' table
#
$count = 0;
while ( $h1 = $sth1->fetchrow_hashref ) {
$count++;
$sth2->execute(
$h1->{id},
sprintf("hpr%04d",$h1->{eps_id}),
$h1->{comment_timestamp},
nullif( $h1->{comment_author_name}, '^\s*$' ),
nullif( $h1->{comment_title}, '^\s*$' ),
$h1->{comment_text},
$h1->{last_changed},
);
if ( $dbh2->err ) {
die $dbh2->errstr;
}
}
print "Copied $count comments\n" if ($verbose > 0);
#
# Set the sequence to the correct value
#
alter_seq( $dbh2, 'comments', 'comment_id', 'comment_seq' );
}
#=== FUNCTION ================================================================
# NAME: update_episodes_table
# PURPOSE: Initialise archiv-related fields in the Pg 'episodes' table
# from the SQLite 'episodes' table
# PARAMETERS: $dbh1 Handle for the SQLite database
# $dbh2 Handle for the Pg database
# $verbose Verbosity level
# RETURNS: Nothing
# DESCRIPTION:
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub update_episodes_table {
my ( $dbh1, $dbh2, $verbose ) = @_;
my ( $sth1, $h1, $sth2, $count );
#
# Query to collect episodes from the SQLite database
#
$sth1 = $dbh1->prepare('SELECT * FROM episodes') or die $DBI::errstr;
if ( $dbh1->err ) {
warn $dbh1->errstr;
}
#
# Query to insert fields into the Pg database 'episodes' table. We just
# write whatever comes in, no check for existing data.
#
$sth2 = $dbh2->prepare(
q{UPDATE episodes SET
archived = ?,
archive_date = ?,
IA_URL = ?
WHERE episode_key = ?}
) or die $DBI::errstr;
if ( $dbh2->err ) {
warn $dbh2->errstr;
}
#
# Query SQLite for the entire 'episodes' table
#
$sth1->execute;
if ( $dbh1->err ) {
die $dbh1->errstr;
}
#
# Loop though 'episodes' table rows writing selected fields to the
# PostgreSQL 'episodes' table
#
$count = 0;
while ( $h1 = $sth1->fetchrow_hashref ) {
$count++;
$sth2->execute(
$h1->{uploaded},
$h1->{archive_date},
$h1->{IA_URL},
sprintf("hpr%04d",$h1->{id}),
);
if ( $dbh2->err ) {
die $dbh2->errstr;
}
}
print "Updated $count rows in the episodes table\n" if ($verbose > 0);
}
#=== FUNCTION ================================================================
# NAME: build_assets_table
# PURPOSE: Copy the data from the SQLite 'assets' table to the Pg
# 'assets' table
# PARAMETERS: $dbh1 Handle for the SQLite database
# $dbh2 Handle for the Pg database
# $verbose Verbosity level
# RETURNS: Nothing
# DESCRIPTION:
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub build_assets_table {
my ( $dbh1, $dbh2, $verbose ) = @_;
my ( $sth1, $h1, $sth2, $count );
#
# Query to collect assets from the SQLite database
#
$sth1 = $dbh1->prepare('SELECT * FROM assets') or die $DBI::errstr;
if ( $dbh1->err ) {
warn $dbh1->errstr;
}
#
# Query to insert asset data into the new database
#
$sth2 = $dbh2->prepare(
q{INSERT INTO assets VALUES (DEFAULT,id_in_episodes(?),?,?,?)}
) or die $DBI::errstr;
if ( $dbh2->err ) {
warn $dbh2->errstr;
}
#
# Query SQLite for the entire 'assets' table
#
$sth1->execute;
if ( $dbh1->err ) {
die $dbh1->errstr;
}
#
# Loop though 'assets' table rows writing them to the PostgreSQL
# 'assets' table
#
$count = 0;
while ( $h1 = $sth1->fetchrow_hashref ) {
$count++;
$sth2->execute(
sprintf("hpr%04d",$h1->{episode_id}),
$h1->{URL},
$h1->{filename},
$h1->{uploaded},
);
if ( $dbh2->err ) {
die $dbh2->errstr;
}
}
print "Copied $count assets\n" if ($verbose > 0);
#
# Set the sequence to the correct value
#
alter_seq( $dbh2, 'assets', 'asset_id', 'asset_seq' );
}
#=== FUNCTION ================================================================
# NAME: resolve_double_hosts
# PURPOSE: Turn any double host entries in the 'hosts' table into
# "singletons"
# PARAMETERS: $dbh1 Handle for the MariaDB database
# $dbh2 Handle for the Pg database
# $template Template for building the default email
# $licence string version of the short CC licence name
# $verbose Verbosity level
# RETURNS: Nothing
# DESCRIPTION:
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub resolve_double_hosts {
my ( $dbh1, $dbh2, $template, $licence, $verbose ) = @_;
my ( $sth1, $h1, $rv1, $sth2, $h2, $rv2, $sth3, $h3, $rv3, $sth4, $h4, $rv4 );
my ( %doubles, @h, %hosts, $count, $unknown );
#
# Search the 'hosts' table in the old database for "host1 and host2"
# strings
#
$count = find_double_hosts($dbh1, \%doubles, \%hosts);
#
# If no doubles there's nothing to do
#
if ($count == 0) {
print "No doubles found\n" if ($verbose > 0);
return;
}
#
# Scan the list of individual hosts we stored earlier and find them in
# the 'hosts' table (assuming that the hostnames we have extracted match
# exactly)
#
$unknown = find_hosts($dbh1, \%doubles, \%hosts);
#
# Allocate all unknown hosts a host id in the PostgreSQL database, and give an
# unique email address.
#
if ( $unknown > 0 ) {
register_unknown($dbh2, \%doubles, \%hosts, $template,
$licence);
}
#
# Now %doubles contains all the original names and host ids and %hosts
# contains the parsed out names and their ids. We can look for shows
# attributed to the double hosts and re-attribute them to the single
# hosts.
#
link_double_twat_episodes($dbh1,$dbh2,\%doubles,$verbose);
link_double_hpr_episodes($dbh1,$dbh2,\%doubles,$verbose);
return;
}
#=== FUNCTION ================================================================
# NAME: find_double_hosts
# PURPOSE: Search the 'hosts' table in the old database for "host1 and
# host2" strings.
# PARAMETERS: $dbh handle for the MariaDB database
# $doubles hashref where details will be stored
# $hosts hashref to contain single host details
# RETURNS: The number of double hosts found
# DESCRIPTION:
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub find_double_hosts {
my ($dbh, $doubles, $hosts) = @_;
my ($sth, $h, @h, $count);
#
# Find the double hosts in the old database
#
$sth = $dbh->prepare(
q{ SELECT hostid, host FROM hosts
WHERE host regexp '[[:<:]]and[[:>:]]'
ORDER BY hostid
}
) or die $DBI::errstr;
if ( $dbh->err ) {
warn $dbh->errstr;
return 0;
}
$sth->execute;
if ( $dbh->err ) {
die $dbh->errstr;
}
#
# Loop through the doubles we found, counting them as we go
#
$count = 0;
while ( $h = $sth->fetchrow_hashref ) {
#
# Each hash value is a hash containing the original id, and, in a sub-hash
# the replacement ids
#
$doubles->{$h->{host}} = {
double => $h->{hostid},
singles => {},
};
#
# Parse the double host string into an array
#
@h = ( $h->{host} =~ /^(.+)\s+and\s+(.+)$/ );
#
# Initialise the entries for %doubles and %hosts
#
for my $host (@h) {
$doubles->{$h->{host}}->{singles}->{$host} = undef;
unless ( exists( $hosts->{$host} ) ) {
$hosts->{$host} = 0;
}
}
$count++;
}
return $count;
}
#=== FUNCTION ================================================================
# NAME: find_hosts
# PURPOSE: Find individual hosts in the old MariaDB database using the
# names we found as double hosts
# PARAMETERS: $dbh handle for the MariaDB database
# $doubles hashref where details will be stored
# $hosts hashref to contain single host details
# RETURNS: The number of unknown hosts
# DESCRIPTION:
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub find_hosts {
my ($dbh, $doubles, $hosts) = @_;
my ($sth, $h, $rv, @h, $unknown);
#
# Query to find the host by name in the old database
#
$sth = $dbh->prepare(q{SELECT hostid FROM hosts WHERE host = ?})
or die $DBI::errstr;
if ( $dbh->err ) {
warn $dbh->errstr;
}
#
# Scan the list of individual hosts we stored earlier and find them in
# the 'hosts' table (assuming that the hostnames we have extracted match
# exactly)
#
$unknown = 0;
foreach my $host ( sort(keys(%{$hosts})) ) {
$rv = $sth->execute($host);
if ( $dbh->err ) {
die $dbh->errstr;
}
$rv = 0 if ( $rv eq '0E0' );
if ($rv) {
#
# Found id for host. Save in the %doubles hash
#
$h = $sth->fetchrow_hashref;
$hosts->{$host} = $h->{hostid};
save_hostid($doubles,$host,$h->{hostid});
}
else {
#
# Can't find this host
#
$unknown++;
}
}
return $unknown;
}
#=== FUNCTION ================================================================
# NAME: register_unknown
# PURPOSE: Create an entry in the 'hosts' table of the new database
# wherever there's a host that's unknown (has a zero id in the
# %hosts hash).
# PARAMETERS: $dbh handle for the MariaDB database
# $doubles hashref where details will be stored
# $hosts hashref to contain single host details
# $email_template template for making an email address
# $licence string version of the short CC licence name
# RETURNS: Nothing
# DESCRIPTION:
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub register_unknown {
my ( $dbh, $doubles, $hosts, $email_template, $licence ) = @_;
my ( $sth, $h, $rv, $new_email );
#
# PostgreSQL query to register an unknown host
#
$sth = $dbh->prepare(
q{INSERT INTO hosts (host,email,license)
VALUES (?,?,id_in_licenses(?))}
) or die $DBI::errstr;
if ( $dbh->err ) {
warn $dbh->errstr;
}
foreach my $host ( sort( keys( %{$hosts} ) ) ) {
if ( $hosts->{$host} == 0 ) {
#
# Write a row to the 'hosts' table. There has to be an email,
# but we can't compute one until the row has been added.
#
$rv = $sth->execute( $host, 'placeholder', $licence );
if ( $dbh->err ) {
die $dbh->errstr;
}
#
# Save the id number we just generated as the new host id
#
my $newid = $dbh->last_insert_id( undef, undef, undef, undef,
{ sequence => 'host_seq' } );
$hosts->{$host} = $newid;
save_hostid( $doubles, $host, $newid );
printf "Created new host %s (%d)\n", $host, $newid
if ( $verbose > 0 );
#
# Give the new host entry a default email address
#
$new_email = sprintf( $email_template, $newid );
$rv = $dbh->do( 'UPDATE hosts SET email = ? WHERE host_id = ?',
undef, $new_email, $newid );
if ( $dbh->err ) {
warn $dbh->errstr;
}
$rv = 0 if ( $rv eq '0E0' );
warn "Failed to set email address $new_email for $host\n"
unless ( defined($rv) );
}
}
}
#=== FUNCTION ================================================================
# NAME: link_double_twat_episodes
# PURPOSE: Find and link TwaT episodes with double hosts
# PARAMETERS: $dbh1 Handle for the MariaDB database
# $dbh2 Handle for the Pg database
# $doubles hashref holding double host details
# $verbose Verbosity level
# RETURNS: Nothing
# DESCRIPTION:
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub link_double_twat_episodes {
my ( $dbh1, $dbh2, $doubles, $verbose ) = @_;
my ( $sth, $h, $rv );
#
# Query to find TwaT shows with particular host names in the old database
#
$sth = $dbh1->prepare(
q{
SELECT ep_num
FROM twat_episodes
WHERE host = ?
}
) or die $DBI::errstr;
if ( $dbh1->err ) {
warn $dbh1->errstr;
}
#
# Loop through the double hosts we collected
#
foreach my $double ( sort( keys(%{$doubles}) ) ) {
#
# Extract saved double and corresponding single details
#
my ( $doubleid, @newhosts ) = (
$doubles->{$double}->{double},
keys( %{ $doubles->{$double}->{singles} } )
);
#
# Find TwaT shows marked as belonging to this double-host (in the old
# database)
#
$sth->execute($double);
if ( $dbh1->err ) {
die $dbh1->errstr;
}
#
# Process all the shows we found
#
while ( $h = $sth->fetchrow_hashref ) {
my $eps_id = $h->{ep_num};
my $episode_key = sprintf("twat%04d",$eps_id);
#
# If one insert into the new database fails they all do
#
$dbh2->begin_work();
#
# Add links for the single hosts to the new database
#
foreach my $host (@newhosts) {
$rv = $dbh2->do(
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 = ?},
undef, $episode_key, $host);
if ( $dbh2->err ) {
warn $dbh2->errstr;
}
$rv = 0 if ( $rv eq '0E0' );
unless ( defined($rv) ) {
warn "Problem adding link to episodes_hosts_xref for "
. "$episode_key,$host\n";
}
else {
printf "Linked show %s for host %s\n", $episode_key, $host;
}
}
#
# Commit the inserts above
#
$dbh2->commit();
}
}
}
#=== FUNCTION ================================================================
# NAME: link_double_hpr_episodes
# PURPOSE: Find and link HPR episodes with double hosts
# PARAMETERS: $dbh1 Handle for the MariaDB database
# $dbh2 Handle for the Pg database
# $doubles hashref holding double host details
# $verbose Verbosity level
# RETURNS: Nothing
# DESCRIPTION:
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub link_double_hpr_episodes {
my ( $dbh1, $dbh2, $doubles, $verbose ) = @_;
my ( $sth, $h, $rv );
#
# Query to find HPR shows with particular host ids in the old database
#
$sth = $dbh1->prepare(
q{
SELECT id AS eps_id
FROM eps
WHERE hostid = ?
}
) or die $DBI::errstr;
if ( $dbh1->err ) {
warn $dbh1->errstr;
}
#
# Loop through the double hosts we collected
#
foreach my $double ( sort( keys(%{$doubles}) ) ) {
#
# Extract saved double and corresponding single details
#
my ( $doubleid, @newhosts ) = (
$doubles->{$double}->{double},
keys( %{ $doubles->{$double}->{singles} } )
);
#
# Find HPR shows marked as belonging to this double-host (in the old
# database)
#
$sth->execute($doubleid);
if ( $dbh1->err ) {
die $dbh1->errstr;
}
#
# Process all the shows we found
#
while ( $h = $sth->fetchrow_hashref ) {
my $eps_id = $h->{eps_id};
my $episode_key = sprintf("hpr%04d",$eps_id);
#
# If one insert into the new database fails they all do
#
$dbh2->begin_work();
#
# Add links for the single hosts to the new database
#
foreach my $host (@newhosts) {
$rv = $dbh2->do(
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 = ?},
undef, $episode_key, $host);
if ( $dbh2->err ) {
warn $dbh2->errstr;
}
$rv = 0 if ( $rv eq '0E0' );
unless ( defined($rv) ) {
warn "Problem adding link to episodes_hosts_xref for "
. "$episode_key,$host\n";
}
else {
printf "Linked show %s for host %s\n", $episode_key, $host;
}
}
#
# Commit the inserts above
#
$dbh2->commit();
}
}
}
#=== FUNCTION ================================================================
# NAME: save_hostid
# PURPOSE: Saves the host id after searching for the key in the %doubles
# hash
# PARAMETERS: $doubles hashref to %doubles
# $host host key
# $hostid host id number
# RETURNS: Nothing
# DESCRIPTION: Searches the %doubles hash for particular keys in the
# 'singles' sub-hash. If found saves the corresponding host id
# there.
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub save_hostid {
my ( $doubles, $host, $hostid ) = @_;
foreach my $key ( keys(%$doubles) ) {
if ( exists( $doubles->{$key}->{singles}->{$host} ) ) {
$doubles->{$key}->{singles}->{$host} = $hostid;
}
}
}
#=== FUNCTION ================================================================
# NAME: compute_host_date_added
# PURPOSE: Determine the 'hosts.when_added' field once the database is
# fully populated.
# PARAMETERS: $dbh Handle for the PostgreSQL database
# RETURNS: Nothing
# DESCRIPTION:
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub compute_host_date_added {
my ($dbh) = @_;
my $rv;
#
# Allocate when_added values where possible
#
$rv = $dbh->do(
q{
UPDATE hosts
SET when_added = sq.when_added
FROM (
SELECT h.host_id,min(e.release_date) AS when_added
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)
GROUP BY h.host_id
ORDER by min(e.release_date)) AS sq
WHERE hosts.host_id = sq.host_id
}
);
if ( $dbh->err ) {
warn $dbh->errstr;
}
$rv = 0 if ( $rv eq '0E0' );
print "Added $rv dates to the 'when_added' column\n";
}
#=== FUNCTION ================================================================
# NAME: alter_seq
# PURPOSE: Ensure the PostgreSQL sequence associated with a table has the
# correct value.
# PARAMETERS: $dbh Handle for the PostgreSQL database
# $table Table name for the query
# $idname Id field name (primary key)
# $sequence Sequence name
# RETURNS: Nothing
# DESCRIPTION:
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub alter_seq {
my ( $dbh, $table, $idname, $sequence ) = @_;
my ( $sth, $h, $rv, $maxid );
#
# Find the maximum id number in the table
#
$sth = $dbh->prepare("SELECT max($idname) as maxid FROM $table")
or die $DBI::errstr;
if ( $dbh->err ) {
warn $dbh->errstr;
}
$sth->execute;
if ( $dbh->err ) {
die $dbh->errstr;
}
#
# Save the maximum
#
if ( $h = $sth->fetchrow_hashref ) {
$maxid = $h->{maxid};
$sth->finish;
}
#
# Reset the sequence one more than the maximum
#
$maxid++;
$rv = $dbh->do("ALTER SEQUENCE $sequence RESTART WITH $maxid");
if ( $dbh->err ) {
warn $dbh->errstr;
}
$rv = 0 if ( $rv eq '0E0' );
warn "Failed to reset $sequence\n" unless (defined($rv));
return;
}
#=== FUNCTION ================================================================
# NAME: check_table
# PURPOSE: Check that a given PostgreSQL table is empty
# PARAMETERS: $dbh Handle for the PostgreSQL database
# $table Name of table
# RETURNS: True if empty, otherwise false
# DESCRIPTION: Simply perform a query on the nominated table which counts
# rows. If the table does not exist a DBI method will fail (the
# execute?), so we treat this as a 'no empty' to make the caller
# take error action.
# THROWS: No exceptions
# COMMENTS: None
# SEE ALSO: N/A
#===============================================================================
sub check_table {
my ( $dbh, $table ) = @_;
my ( $sth, $h, $count );
$sth = $dbh->prepare("SELECT count(*) AS count FROM $table")
or die $DBI::errstr;
if ( $dbh->err ) {
warn $dbh->errstr;
return 0;
}
$sth->execute;
if ( $dbh->err ) {
warn $dbh->errstr;
return 0;
}
if ( $h = $sth->fetchrow_hashref ) {
$count = $h->{count};
$sth->finish;
}
return $count == 0;
}
#=== 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: 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: 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
copy_mysql_pg - copy the HPR database from MySQL to PostgreSQL
=head1 VERSION
This documentation refers to B<copy_mysql_pg> version 0.1.5
=head1 USAGE
copy_mysql_pg2 -verbose
copy_mysql_pg2 -config=.hpr_livedb.cfg -verbose
copy_mysql_pg2 -verbose \
-phase='episodes,hosts,eh_xref,series,es_xref,tags,comments,archived,assets,epilogue'
=head1 OPTIONS
=over 8
=item B<-help>
Prints a brief help message describing the usage of the program, and then exits.
=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
=back
=item B<-[no]dry-run>
When enabled (B<-dry-run>) the script will report what it would do, but will
make no changes to the target database. In the default state (B<-nodry-run>)
then changes are made.
=item B<-verbose>
Makes the script verbose resulting in the production of more information about
what it is doing.
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>
A message is generated per phase to indicate which actions are taking place.
This includes a report of the number of rows copied from the MySQL database to
the PostgreSQL one.
=item B<2>
Following the process of collecting the CSV tags from the MySQL 'episodes' table
these are reported as a list per episode. This output will be long!
=back
=item B<-phase=CSV_LIST>
This option allows the phases of the copying process to be selected
individually. The argument B<CSV_LIST> is a list of phase names, which have to
be typed exactly. The order is not important since the script will scan its
version of the list of phases in its own order and will check to see if each
has been selected.
The phase names are:
=over 4
=item B<episodes>
Causes the B<episodes> table to be filled.
=item B<hosts>
Causes the B<hosts> table to be filled.
=item B<eh_xref>
Causes the B<episodes_hosts_xref> table to be filled.
=item B<series>
Causes the B<series> table to be filled.
=item B<es_xref>
Causes the B<episodes_series_xref> table to be filled.
=item B<tags>
Causes the B<tags> and the B<episodes_tags_xref> tables to be filled.
=item B<comments>
Causes the B<comments> table to be filled.
=item B<archived>
Causes the archive-related fields of the B<episodes> table to be filled from
the SQLite database B<ia.db>.
=item B<assets>
Causes the B<assets> table to be filled from the SQLite database B<ia.db>.
=item B<epilogue>
Runs various tasks that can only be carried out after the database has been
populated.
=back
=back
=item B<-config=FILE>
This option allows an alternative configuration file to be used. This file
defines the location of the database, its port, its name and the username and
password to be used to access it. This feature was added to allow the script
to access alternative databases or the live database over an SSH tunnel.
See the CONFIGURATION AND ENVIRONMENT section below for the file format.
If the option is omitted the default file is used: B<.hpr_db.cfg>
=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
The script obtains the credentials it requires to open the HPR database from
a configuration file. The name of the file it expects is B<.hpr_db.cfg> in the
directory holding the script. To change this will require changing the script.
The configuration file format is as follows:
<database>
host = 127.0.0.1
port = PORT
name = DATABASE
user = USERNAME
password = PASSWORD
</database>
=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 <Maintainer name(s)> (<contact address>)
Patches are welcome.
=head1 AUTHOR
Dave Morriss (Dave.Morriss@gmail.com)
=head1 LICENCE AND COPYRIGHT
Copyright (c) 2017-2019 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 Copy Permalink