# ==================================================================
# Gossamer Links - enhanced directory management system
#
#   Website  : http://gossamer-threads.com/
#   Support  : http://gossamer-threads.com/scripts/support/
#   CVS Info : 087,071,086,086,085      
#   Revision : $Id: Upgrade.pm,v 1.50 2009/05/11 05:57:45 brewt Exp $
# 
# Copyright (c) 2005 Gossamer Threads Inc.  All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================
#

package Links::Upgrade;

use strict;
use vars qw/%VERSION_TREE @VERSION_HIDDEN/;
use Carp;
BEGIN {
    # 1.01 below should be updated if this file depends on fixes/additions to GT::SQL::Upgrade
    if (exists $INC{'GT/SQL/Upgrade.pm'} and $GT::SQL::Upgrade::VERSION < 1.01) {
        delete $INC{'GT/SQL/Upgrade.pm'};
    }
}
use GT::SQL::Upgrade;

# This has to be updated every release so that an upgrade can "walk" the tree
# to find any upgrade code.
%VERSION_TREE = (
    '2.0.0' => '2.0.1',
    '2.0.1' => '2.0.2',
    '2.0.2' => '2.0.3',
    '2.0.3' => '2.0.4',
    '2.0.4' => '2.0.5',
    '2.0.5' => '2.1.0',
    '2.1.0' => '2.1.1',
    '2.1.1' => '2.1.2',
    '2.1.2' => '2.2.0',
    '2.2.0' => '2.2.1',
    '2.2.1' => '2.99.0',
    '2.99.0' => '2.99.1',
    '2.99.1' => '3.0.0',
    '3.0.0' => '3.0.1',
    '3.0.1' => '3.0.2',
    '3.0.2' => '3.0.3',
    '3.0.3' => '3.0.4',
    '3.0.4' => '3.1.0',
    '3.1.0' => '3.2.0',
    '3.2.0' => '3.3.0',
);

# These versions won't show up in the available upgrade list returned by
# upgrades_available().
@VERSION_HIDDEN = ('2.99.0', '2.99.1');

sub PERFORM ($$) { "\nPerforming " . (substr($_[0], 0, 1) == 2 ? "Links SQL" : "Gossamer Links") . " $_[0] -> $_[1] upgrades...\n" }
sub DONE ($$) { (substr($_[0], 0, 1) == 2 ? "Links SQL" : "Gossamer Links") . " $_[0] -> $_[1] upgrades performed.\n\n" }

# In list context, returns a list of versions that are available to be upgraded
# from.  In scalar context, returns a hash reference containing a
# upgrades_available key with a value of an array reference containing these
# versions (i.e. for use in a template).  Only versions from %VERSION_TREE are
# included that actually have some upgrade code - in other words, 2.0.1 won't
# be includeded because there is no actual 2.0.1 upgrade code.
sub upgrades_available {
    my %skip = map { $_ => 1 } @VERSION_HIDDEN;
    my @avail =
        map $_->[0],
        sort { for my $i (1 .. (@$a > @$b ? @$a : @$b)) { my $c = $a->[$i] <=> $b->[$i]; return $c if $c } 0 }
        map { ($skip{$_} or !__PACKAGE__->can_upgrade($_)) ? () : [$_, split /\./] }
        keys %VERSION_TREE;
    return wantarray ? @avail : { upgrades_available => \@avail };
}

# Usage:
# Links::Upgrade->upgrade(
#     from => $version, # e.g.  2.2.1
#     output => $coderef, # code reference will be called with any output
#     config => $config, # config object or hash reference (may be changed by upgrade code)
# );
sub upgrade {
    my $class = shift;
    my %opts = @_;
    for (qw/from config/) {
        $opts{$_} or croak "Links::Upgrade->upgrade requires a '$_' option";
    }

    my ($version) = $opts{from} =~ /(\d+\.\d+\.\d+)/;
    $version or croak "Invalid version passed to Links::Upgrade->upgrade: '$opts{from}'";

    ref $opts{config} eq 'HASH' or UNIVERSAL::isa($opts{config}, 'GT::Config') or croak "Invalid 'config' value passed to Links::Upgrade->upgrade: '$opts{config}' not a hash reference or GT::Config object.";
    not $opts{output} or ref $opts{output} eq 'CODE' or croak "Invalid 'output' value passed to Links::Upgrade->upgrade: '$opts{output}' not a code reference.";
    $opts{output} ||= sub { print @_ };

    my $safety;
    while ($version) {
        if (my $sub = $class->can_upgrade($version)) {
            $sub->($opts{output}, $opts{config});
        }
        $safety++ < 100 or croak "Internal upgrade error: $version => $VERSION_TREE{$version} appears to be recursing.";
    }
    continue { $version = $VERSION_TREE{$version} }

# Walk the version upgrade tree
    1;
}

# Takes a version, returns a code reference if the version -> next version
# upgrade code exists, undef otherwise.
sub can_upgrade {
    my ($class, $from) = @_;
    my $to = $VERSION_TREE{$from};
    for ($from, $to) { y/./_/ }
    $class->can("upgrade__${from}__$to");
}

# Called from GT::Template with the version to upgrade from.  Returns either an
# error tag or a message tag.
sub browser_upgrade {
    my ($from, $stream) = @_;
    $from and $from =~ /\d\.\d+\.\d/ or return { error => 'Invalid upgrade version entered.' };
    my $ret = '';
    __PACKAGE__->upgrade(
        from => $from,
        config => $Links::CFG,
        output => sub { if ($stream) { print @_ } else { $ret .= join '', @_ } }
    );

    return {
        upgrade_successful => 1,
        upgrade_result => $ret
    };
}

# Although not strictly upgrade-specific (you can force a tree rebuild) it is
# here as it is primarily an upgrade feature.
# Takes 2-3 arguments - an output subroutine, a GT::SQL object, and an optional
# force value - if specified and true, a rebuild will be forced.
sub create_cat_tree {
    my ($out, $DB, $force) = @_;
    $out ||= sub { print @_ };

    require GT::SQL::Tree;
    require GT::SQL::Tree::Rebuild;
    my $t = $DB->table('Category');
    my %roots;
    my $rebuild = GT::SQL::Tree::Rebuild->new(
        table => $t,
        order_by => 'Full_Name', # Ensure that parents come before children
        cols => [qw/ID FatherID Full_Name/],
        missing_root => sub {
            my ($row, $table) = @_;
            my ($id, $father) = @$row{qw/ID FatherID/};
            if (!$father) {
                return $roots{$id} = 0;
            }
            my $root;
            if (exists $roots{$father}) {
                return $roots{$id} = $roots{$father} || $father;
            }
            else {
                die "No parent category found for $row->{Full_Name}! Your Category table is corrupted.";
            }
        },
        missing_depth => sub {
            my ($row, $table) = @_;
            my $full_name = $row->{Full_Name};
            return $row->{Full_Name} =~ y|/||;
        }
    );

    my $e = $DB->editor('Category');
    $out->("Adding Category tree...\n");
    my $ret = $e->add_tree(father => "FatherID", root => "CatRoot", depth => "CatDepth", force => $force ? 'force' : 'check', rebuild => $rebuild);
    $out->($ret ? "\tOkay!\n" : "\tAn error occured: $GT::SQL::error\n");
    $ret;
}

sub browser_cat_tree {

    my $stream = shift;
    my $message;
    my $okay = create_cat_tree(sub { if ($stream) { print @_ } else { for (@_) { $message .= $_ } } }, $Links::DB, 1);
    return { browser_cat_tree_success => $okay, browser_cat_tree_message => $message };
}

sub upgrade__3_2_0__3_3_0 {
# ---------------------------------------------------------------
# Upgrade from 3.2.0 to 3.3.0
#
    my ($out, $cfg) = @_;
    $out->(PERFORM '3.2.0' => '3.3.0');

    import lib $cfg->{admin_root_path};
    require GT::SQL;
    require GT::SQL::Table;
    $Links::DB = my $DB = GT::SQL->new($cfg->{admin_root_path} . '/defs');
    require GT::Config;
    my $lang = GT::Config->load("$cfg->{admin_root_path}/templates/admin/language.txt");

# Gossamer Links German fix
    if ($cfg->{date_review_format} eq '%dd.%mm%.%yyyy% %HH%:%MM%') {
        $cfg->{date_review_format} = '%dd%.%mm%.%yyyy% %HH%:%MM%';
    }

# These options were split into two, so they should retain the same value as the original option
    if ($cfg->{build_new_date_span_pages} ne $cfg->{build_span_pages}) {
        $cfg->{build_new_date_span_pages} = $cfg->{build_span_pages};
    }
    if ($cfg->{email_review_add} ne $cfg->{email_add}) {
        $cfg->{email_review_add} = $cfg->{email_add};
    }

    $out->("Turning on build_format_compat...\n\tOkay!\n");
    $cfg->{build_format_compat} = 2;

# Add new Reviews subclass
    $out->("Adding Reviews subclass...\n");
    my $t = $DB->table('Reviews');
    $t->subclass(
        table => { Reviews => "Links::Table::Reviews" }
    );
    $t->save_state();
    $out->("\tOkay!\n");

    $out->(DONE '3.2.0' => '3.3.0');
}

sub upgrade__3_1_0__3_2_0 {
# ---------------------------------------------------------------
# Upgrade from 3.1.0 to 3.2.0
#
    my ($out, $cfg) = @_;
    $out->(PERFORM '3.1.0' => '3.2.0');

    import lib $cfg->{admin_root_path};
    require GT::SQL;
    require GT::SQL::Table;
    $Links::DB = my $DB = GT::SQL->new($cfg->{admin_root_path} . '/defs');
    require GT::Config;
    my $lang = GT::Config->load("$cfg->{admin_root_path}/templates/admin/language.txt");

    $out->("Updating PayPal postback check...\n");
    for my $postback (@{$cfg->{payment}->{postback}}) {
        next unless $postback->{method} eq 'PayPal';
        $postback->{var} = 'txn_type';
        last;
    }
    $out->("\tOkay!\n");

    $out->("Updating review e-mail settings...\n");
    if ($cfg->{admin_email_review_add}) {
        $cfg->{admin_email_review_add} = $cfg->{admin_email_add};
    }
    if ($cfg->{admin_email_review_mod}) {
        $cfg->{admin_email_review_mod} = $cfg->{admin_email_mod};
    }
    $out->("\tOkay!\n");

    $out->("Removing old browser templates from admin template set...\n");
    my $dir = "$cfg->{admin_root_path}/templates/admin";
    opendir TPL, $dir or die "Could not open '$dir': $!";
    while (defined(my $file = readdir TPL)) {
        next unless -f "$dir/$file" and $file =~ /^browser.*\.html$/;
        unlink "$dir/$file";
    }
    $out->("\tOkay!\n");

    add_column($out, $DB, Sessions => session_expires => { type => 'TINYINT', default => 1 });
    add_column($out, $DB, Reviews => Review_ModifyDate => { type => 'DATETIME', not_null => 1, default => '0000-00-00 00:00:00', form_display => $lang->{prompt_Review_ModifyDate} });
    alter_column($out, $DB, Reviews => Review_Date => { type => 'DATETIME', not_null => 1, form_display => $lang->{prompt_Review_Date} });

    $out->(DONE '3.1.0' => '3.2.0');
}

sub upgrade__3_0_4__3_1_0 {
# -----------------------------------------------------------------------------
# Upgrade from 3.0.4 to 3.0.5
    my ($out, $cfg) = @_;

    $out->(PERFORM '3.0.4' => '3.1.0');

    import lib $cfg->{admin_root_path};
    require GT::SQL;
    require GT::SQL::Table;
    $Links::DB = my $DB = GT::SQL->new($cfg->{admin_root_path} . '/defs');
    require GT::Config;
    my $lang = GT::Config->load("$cfg->{admin_root_path}/templates/admin/language.txt");

    drop_index($out, $DB, CatLinks => 'catlnndx');

    $out->("Scanning for and removing duplicate entries from CatLinks table...\n");
    # Do some hackery to get a non-subclassed CatLinks table
    #my $catlinks = $DB->table('CatLinks');
    my $catlinks = GT::SQL::Table->new(
        name => $DB->prefix . 'CatLinks',
        connect => $DB->{connect},
        debug => $DB->{_debug},
        _err_pkg => 'GT::SQL::Table'
    );
    $catlinks->select_options('GROUP BY LinkID, CategoryID', 'HAVING COUNT(*) > 1');
    my $sth = $catlinks->select(qw[LinkID CategoryID COUNT(*)]);
    my $count;
    while (my ($linkid, $catid) = $sth->fetchrow) {
        my $deleted = $catlinks->delete({ LinkID => $linkid, CategoryID => $catid });
        $count += $deleted - 1;
        $catlinks->insert({ LinkID => $linkid, CategoryID => $catid });
    }
    $out->("\tOkay! " . ($count ? "$count duplicate entries found and removed.\n" : "No duplicate entries found.\n"));

    add_unique($out, $DB, CatLinks => { cl_cl_q => [qw/CategoryID LinkID/] });


    if ($cfg->{updates}) {
        $out->("Moving update data from Links/Config/Data.pm to Links/Config/Updates.pm\n");
        my $cfg_updates = delete $cfg->{updates};
        require GT::Config;
        my $updates = GT::Config->load("$cfg->{admin_root_path}/Links/Config/Updates.pm", { create_ok => 1 });
        for (keys %$cfg_updates) {
            $updates->{$_} ||= $cfg_updates->{$_};
        }
        $updates->save;
        $out->("\tOkay!\n");
    }

    add_column($out, $DB, Links => LinkExpired => { type => 'INT', form_display => $lang->{prompt_LinkExpired}, form_type => 'hidden' });
    add_index($out, $DB, Category => { c_p => ['Payment_Mode'] });

    $out->(DONE '3.0.4' => '3.1.0');
}

sub upgrade__3_0_3__3_0_4 {
# ---------------------------------------------------------------
# Upgrade from 3.0.3 to 3.0.4
#
    my ($out, $cfg) = @_;
    $out->(PERFORM '3.0.3' => '3.0.4');
    $out->(DONE '3.0.3' => '3.0.4');
}

sub upgrade__3_0_2__3_0_3 {
# ---------------------------------------------------------------
# Upgrade from 3.0.2 to 3.0.3
#
    my ($out, $cfg) = @_;
    $out->(PERFORM '3.0.2' => '3.0.3');
    $out->(DONE '3.0.2' => '3.0.3');
}

sub upgrade__3_0_1__3_0_2 {
# ---------------------------------------------------------------
# Upgrade from 3.0.1 to 3.0.2
#
    my ($out, $cfg) = @_;
    $out->(PERFORM '3.0.1' => '3.0.2');
    $out->(DONE '3.0.1' => '3.0.2');
}

sub upgrade__3_0_0__3_0_1 {
# ---------------------------------------------------------------
# Upgrade from 3.0.0 to 3.0.1
#
    my ($out, $cfg) = @_;
    $out->(PERFORM '3.0.0' => '3.0.1');

    import lib $cfg->{admin_root_path};
    require GT::SQL;
    $Links::DB = my $DB = GT::SQL->new($cfg->{admin_root_path} . '/defs');

    recreate_table($out, $DB, 'MailingListIndex', sub { my $table = shift; my $cols = $table->cols; $cols->{Name}->{type} eq 'TEXT' },
        cols => [
            ID           => { type => 'INT', unsigned => 1, not_null => 1 },
            Name         => { type => 'CHAR', size => 255, not_null => 1 },
            DateModified => { type => 'INT', not_null => 1 },
            DateCreated  => { type => 'INT', not_null => 1 }
        ],
        pk => 'ID',
        ai => 'ID'
    );

    if (-e(my $oldconfig = "$cfg->{admin_root_path}/Links/ConfigData.pm")) {
        $out->("Removing old Links/ConfigData.pm file (has been replaced with Links/Config/Data.pm)...\n");
        require GT::File::Tools;
        my $ret = GT::File::Tools::move($oldconfig, "$oldconfig.old");
        $out->($ret ? "\tOkay!\n" : "\tAn error occured: $!\n");
    }

    $out->(DONE '3.0.0' => '3.0.1');
}

sub upgrade__2_99_1__3_0_0 {
# -----------------------------------------------------------------------------
# Placeholders that currently just prints a 2.2.1 -> 3.0.0 success message.  If
# a 2.99.1 is released, this will become 2_99_1__3_0_0 and so on.  This allows
# transparent handling of the beta versions without duplicating any code and
# without needing to mention the beta in the upgrade output.
#
    my ($out, $cfg) = @_;

    $out->("Updating build_static_path, _url...\n");
    $cfg->{build_static_path} ||= "$cfg->{build_root_path}/static";
    $cfg->{build_static_url} ||= "$cfg->{build_root_url}/static";
    $out->("\tOkay!\n");

    $out->(DONE '2.2.1' => '3.0.0');
}

sub upgrade__2_99_0__2_99_1 {
# ---------------------------------------------------------------
# Upgrade from 2.99.0 to 2.99.1
#
    my ($out, $cfg) = @_;
    import lib $cfg->{admin_root_path};
    require GT::Config;
    my $lang = GT::Config->load("$cfg->{admin_root_path}/templates/admin/language.txt");

    require GT::SQL;
    $Links::DB = my $DB = GT::SQL->new("$cfg->{admin_root_path}/defs");

# Drop unnecessary Bookmark columns added to the Users table in 2.99.0
    my $usercols = $DB->table('Users')->cols;
    for (qw/FolderSortField FolderSortOrd/) {
        drop_column($out, $DB, 'Users', $_) if exists $usercols->{$_};
    }

    delete $cfg->{bookmark_folder_sort};
    delete $cfg->{bookmark_folder_sort_order};
    delete $cfg->{bookmark_user_sort};
    delete $cfg->{bookmark_user_sort_order};

# Don't print here - the final 2.99.x -> 3.0.0 code prints the final message.
    1;
}

sub upgrade__2_2_1__2_99_0 {
# ---------------------------------------------------------------
# Upgrade from 2.2.1 to 2.99.0
#
    my ($out, $cfg) = @_;
    $out->(PERFORM '2.2.1' => '3.0.0');
    import lib $cfg->{admin_root_path};
    require GT::Config;
    my $lang = GT::Config->load("$cfg->{admin_root_path}/templates/admin/language.txt");

    require GT::SQL;
    $Links::DB = my $DB = GT::SQL->new("$cfg->{admin_root_path}/defs");
    $Links::STASH{clicktrack_cleanup} = 1;
    $Links::STASH{expired_links} = 1;

    require Links::Plugins;
    require GT::Plugins::Manager;
    my $plugin = GT::Config->load("$cfg->{admin_root_path}/Plugins/plugin.cfg", { create_ok => 1 });
    {
        package FakeCGI;
        sub param { $_[0]->{$_[1]} }
    }

    add_column($out, $DB, Category => CatRoot => { type => 'INT', not_null => 1, unsigned => 1, default => 0, form_type => 'hidden' });
    add_column($out, $DB, Category => CatDepth => { type => 'INT', not_null => 1, unsigned => 1, default => 0, form_type => 'hidden' });
    add_column($out, $DB, Category => Direct_Links => { type => 'INT', not_null => 1, default => 0, form_display => $lang->{prompt_Direct_Links} });

    create_cat_tree($out, $DB);

    my $t = $DB->table('Category');
    $out->("Updating Category fk to reference itself...\n");
    my $ret = $t->fk(Category => { FatherID => 'ID' });
    $out->($ret ? "\tOkay!\n" : "\tAn error occured: $GT::SQL::error\n");

    $out->("Updating CatLinks subclass...\n");
    $t = $DB->table('CatLinks');
    $t->subclass(
        table => { CatLinks => "Links::Table::CatLinks" }
    );
    $t->save_state();
    $out->("\tOkay!\n");

    $out->("Updating ClickTrack subclass...\n");
    $t = $DB->table('ClickTrack');
    $t->subclass(
        table => { ClickTrack => "Links::Table::ClickTrack" }
    );
    $t->save_state();
    $out->("\tOkay!\n");

    $out->("Updating Direct_Links values...\n");
    my $rel = $DB->table(qw/CatLinks Links/);
    $rel->select_options("GROUP BY CategoryID");
    my $where = GT::SQL::Condition->new(isValidated => '=' => 'Yes');
    $where->add(ExpiryDate => '>=' => time) if $cfg->{payment}->{enabled};
    my %catlinks = $rel->select(qw/CategoryID COUNT(ID)/ => $where)->fetchall_list;
    $t = $DB->table('Category');
    for (keys %catlinks) {
        $t->update({ Direct_Links => $catlinks{$_} }, { ID => $_ }, { GT_SQL_SKIP_CHECK => 1, GT_SQL_SKIP_INDEX => 1 });
    }
    $out->("\tOkay!\n");

    if ($plugin and exists $plugin->{Bookmark}) {
        my $bcfg = Links::Plugins::get_plugin_user_cfg('Bookmark');
        $out->("Bookmark plugin detected, importing Bookmark settings...\n");
        $out->("\tImporting Bookmark configuration...\n");
        for (keys %$bcfg) {
            $cfg->{"bookmark_$_"} = $bcfg->{$_};
        }
        $out->("\t\tDone!\n");

        $out->("\tUninstalling Bookmark plugin...\n");
        my $fakein = bless { plugin_name => "Bookmark", skip_uninstall => 1 }, "FakeCGI";
        my $man = new GT::Plugins::Manager(cgi => $fakein, plugin_dir => "$cfg->{admin_root_path}/Plugins");
        $ret = $man->uninstall;
        $out->($ret->{error} ? "\t\tAn error occured: $ret->{error}\n" : "\t\tDone!\n");
    }

    add_table($out, $DB, 'Bookmark_Folders',
        cols => [
            my_folder_id               => { type => 'INT', not_null => 1, unsigned => 1 },
            my_folder_name             => { type => 'VARCHAR', not_null => 1, size => 255 },
            my_folder_description      => { type => 'VARCHAR', size => 255 },
            my_folder_user_username_fk => { type => 'VARCHAR', size => 50 },
            my_folder_default          => { type => 'TINYINT', not_null => 1, default => 0, unsigned => 1 },
            my_folder_public           => { type => 'TINYINT', not_null => 1, default => 0, unsigned => 1 }
        ],
        pk => 'my_folder_id',
        ai => 'my_folder_id',
        fk => {
            Users => { my_folder_user_username_fk => 'Username' }
        }
    );

    add_table($out, $DB, 'Bookmark_Links',
        cols => [
            my_id               => { type => 'INT', not_null => 1, unsigned => 1 },
            my_link_id_fk       => { type => 'INT', not_null => 1, unsigned => 1 },
            my_user_username_fk => { type => 'VARCHAR', size  => 50 },
            my_folder_id_fk     => { type => 'INT', not_null => 1, unsigned => 1 },
            my_comment          => { type => 'VARCHAR', size  => '255' }
        ],
        pk => 'my_id',
        ai => 'my_id',
        fk => {
            Users            => { my_user_username_fk => 'Username' },
            Bookmark_Folders => { my_folder_id_fk => 'my_folder_id' },
            Links            => { my_link_id_fk => 'ID' },
        }
    );

# Commented out columns were removed in 2.99.1
#    add_column($out, $DB, Users => FolderSortField => { type => 'VARCHAR', size => 255, not_null => 1, regex => '^[\s\w]+$', default => 'my_folder_name', form_display => $lang->{prompt_FolderSortField} });
#    add_column($out, $DB, Users => FolderSortOrd => { type => 'ENUM', values => ['ASC', 'DESC'], not_null => 1, default => 'ASC', form_display => $lang->{prompt_FolderSortOrd} });
    add_column($out, $DB, Users => SortField => { type => 'VARCHAR', size => 255, not_null => 1, regex => '^[\s\w]+$', default => 'Title', form_display => $lang->{prompt_SortField} });
    add_column($out, $DB, Users => SortOrd => { type => 'ENUM', values => ['ASC', 'DESC'], not_null => 1, default => 'ASC', form_display => $lang->{prompt_SortOrd} });
    add_column($out, $DB, Users => PerPage => { type => 'INT', not_null => 1, unsigned => 1, default => 15, form_display => $lang->{prompt_PerPage} });
    add_column($out, $DB, Users => Grouping => { type => 'TINYINT', not_null => 1, unsigned => 1, default => 0, form_display => $lang->{prompt_Grouping} });

    add_column($out, $DB, Editors => CanModReview => { type => 'ENUM', values => ['No', 'Yes'], not_null => 1, default => 'No' });

# Integrate the user's email template changes into the new templates
    $out->("Upgrading email templates...\n");
    require GT::File::Tools;
    require GT::Mail;
    require GT::Mail::Parse;
    my %files = (
        'email-add.txt' => {
            new_name => 'link_added.eml',
            subject  => 'VAL_APPROVESUB',
        },
        'email-del.txt' => {
            new_name => 'link_rejected.eml',
            subject  => 'VAL_REJECTSUB',
        },
        'email-mod.txt' => {
            new_name => 'link_modified.eml',
            subject  => 'VAL_APPROVECHGSUB',
        },
        'email-notify.txt' => {
            new_name => 'link_expiry_notify.eml',
            subject  => 'LINKS_NOTIFY_SUBJECT',
        },
        'email-expired.txt' => {
            new_name => 'link_expired.eml',
            subject  => 'LINKS_NOTIFY_SUBJECT',
        },
        'email-password.txt' => {
            new_name => 'password.eml',
            subject  => 'USER_LOSTPASSSUB',
        },
        'email-validate.txt' => {
            new_name => 'validate.eml',
            subject  => 'USER_VALEMAILSUB',
        },
        'review-email-add.txt' => {
            new_name => 'review_added.eml',
            subject  => 'REVIEW_VAL_APPROVESUB',
        },
        'review-email-del.txt' => {
            new_name => 'review_rejected.eml',
            subject  => 'VAL_REJECTSUB',
        }
    );
    my $new_template = 'luna';
    my $template_path = "$cfg->{admin_root_path}/templates";
    my $fh = \do { local *FH; *FH };
    opendir $fh, $template_path or die "Could not open '$template_path': $!";
    while (my $template_set = readdir $fh) {
        next if $template_set =~ /^\./ or $template_set eq 'admin' or $template_set eq $new_template
            or $template_set =~ /_php$/ or $template_set =~ /^lang_.*\./ or not -d "$template_path/$template_set"
            or $template_set eq 'browser' or $template_set eq 'CVS';
        $out->("\tUpgrading $template_set template set...\n");
        my $l = GT::Template::Inheritance->get_path(file => "language.txt", path => "$template_path/$template_set", use_local => 1, use_inheritance => 1);
        unless (-e $l) {
            $out->("\t\t(no language.txt found, not a template set?)\n");
            next;
        }
        my $clang = GT::Config->load($l);
        for my $file (keys %files) {
            if (not -e "$template_path/$template_set/$files{$file}->{new_name}" and -e "$template_path/$new_template/$files{$file}->{new_name}") {
                GT::File::Tools::copy("$template_path/$new_template/$files{$file}->{new_name}", "$template_path/$template_set/$files{$file}->{new_name}");
            }
            next unless -e "$template_path/$template_set/local/$file" and -r _ and not -e "$template_path/$template_set/local/$files{$file}->{new_name}";
            $out->("\t\tCreating $files{$file}->{new_name} from $file... ");
            open BODY, "$template_path/$template_set/local/$file" or die "Couldn't open template $template_path/$template_set/local/$file: $!";
            my $body;
            {
                local $/;
                $body = <BODY>;
            }
            close BODY;

            next unless -e "$template_path/$new_template/$files{$file}->{new_name}";
            my $top = GT::Mail::Parse->new(
                in_file        => "$template_path/$new_template/$files{$file}->{new_name}",
                crlf           => "\n",
                headers_intact => 0
            )->parse();

            $top->body_data($body) if $body;
            $top->set(Subject => $clang->{$files{$file}->{subject}}) if $clang->{$files{$file}->{subject}};

            if ($body or $clang->{$files{$file}->{subject}}) {
                my $mail = new GT::Mail;
                $mail->top_part($top);
                $mail->write("$template_path/$template_set/local/$files{$file}->{new_name}");
            }
            $out->("done!\n");
# We could also delete the subject language keys and the old email templates,
# but it's better we leave them around than delete something they might not
# want to lose or if something else is still using them.
        }
        $out->("\t\tOkay!\n");
    }
    closedir $fh;
    $out->("\tOkay!\n");

    if (delete $cfg->{foreign_char}) {
        $cfg->{build_category_format} = '%Full_ID%';
        $cfg->{build_category_dynamic} = 'ID';
    }
    elsif (my $f = delete $cfg->{build_directory_field}) {
        $cfg->{build_category_format} = $f ? "%$f%" : '';
        $cfg->{build_category_dynamic} = $f;
    }

    add_table($out, $DB, 'SearchLogs',
        cols => [
            slog_query => { type => 'VARCHAR', not_null => 1, size => 255 },
            slog_count => { type => 'INT', not_null => 1, default => 0 },
            slog_hits  => { type => 'INT', not_null => 1, default => 0 },
            slog_time  => { type => 'FLOAT' },
            slog_last  => { type => 'INT', not_null => 1, default => 0 },
        ],
        pk => 'slog_query'
    );

    if ($plugin and exists $plugin->{SearchLogger} and $DB->table('SearchLog')) {
        $out->("SearchLogger plugin detected, importing SearchLogger settings...\n");
        my $old = $DB->table('SearchLog');
        my $new = $DB->table('SearchLogs');
        require GT::Date;
        $out->("\tTransferring old search logs...\n");
        my $sth = $old->select(qw/Term HitCount Results Last_Hit/);
        my $i;
        if ($sth) {
            while (my $row = $sth->fetchrow_hashref) {
                $i++;
                my %slog_row = (
                    slog_query => $row->{Term},
                    slog_count => $row->{HitCount},
                    slog_hits  => $row->{Results},
                    slog_time  => undef
                );
                my @time;
                if ($row->{Last_Hit} =~ /^(\d{4}-\d\d-\d\d ( ?)\d?\d:\d\d:\d\d)/) {
                    @time = GT::Date::parse_format($1, "%yyyy%-%mm%-%dd% $2%H%:%MM%:%ss%");
                }
                elsif ($row->{Last_Hit} =~ /^(\d{4}-\d\d-\d\d)/) {
                    @time = GT::Date::parse_format($1, '%yyyy%-%mm%-%dd%');
                }
                $slog_row{slog_last} = @time ? GT::Date::timelocal(@time) : 0;
                $ret = $new->insert(\%slog_row);
                $out->("\t\tAn error occured: $GT::SQL::error\n") unless $ret;
            }
            $out->("\t\t$i rows imported.\n");
        }
        else {
            $out->("\t\tAn error occured: $GT::SQL::error\n");
        }

        $out->("\tDropping SearchLog table...\n");
        my $e = $DB->editor('SearchLog');
        my $ret = $e->drop_table;
        $out->($ret ? "\t\tOkay!\n" : "\t\tAn error occured: $GT::SQL::error\n");

        $out->("\tUninstalling SearchLogger plugin...\n");
        my $fakein = bless { plugin_name => "SearchLogger", skip_uninstall => 1 }, "FakeCGI";
        my $man = new GT::Plugins::Manager(cgi => $fakein, plugin_dir => "$cfg->{admin_root_path}/Plugins");
        $ret = $man->uninstall;
        $out->("\t\tOkay!\n");
    }

    add_table($out, $DB, 'NewsletterSubscription',
        cols => [
            UserID     => { type => 'CHAR', size => 50 },
            CategoryID => { type => 'INT', not_null => 1 },
        ],
        unique => {
            ns_uc => ['UserID', 'CategoryID']
        },
        fk => {
            Users    => { UserID => 'Username' },
            Category => { CategoryID => 'ID' }
        }
    );

    if (exists $DB->table('Users')->cols->{Newsletter}) {
        $out->("Importing User Newsletter settings...\n");
        my $sth = $DB->table('Users')->select('Username', { Newsletter => 'Yes' });
        my $ns = $DB->table('NewsletterSubscription');
        if ($sth) {
            while (my $user = $sth->fetchrow) {
                $ns->insert({ UserID => $user, CategoryID => 0 });
            }
            $out->("\tOkay!\n");
        }
        else {
            $out->("\tAn error occured: $GT::SQL::error\n");
        }

        drop_column($out, $DB, 'Users', 'Newsletter');
    }

# Don't print here - the final 2.99.x -> 3.0.0 code prints the final message.
#    $out->("Links SQL 2.2.1 -> 3.0.0 upgrades performed.\n");
    1;
}

sub upgrade__2_2_0__2_2_1 {
# ---------------------------------------------------------------
# Upgrade from 2.2.0 to 2.2.1
#
    my ($out, $cfg) = @_;
    $out->(PERFORM '2.2.0' => '2.2.1');

    import lib $cfg->{admin_root_path};
    require GT::SQL;
    $Links::DB = my $DB = GT::SQL->new($cfg->{admin_root_path} . '/defs');
    $Links::STASH{expired_links} = 1;

    require GT::Config;
    my $lang = GT::Config->load($cfg->{admin_root_path} . '/templates/admin/language.txt');

# Update Rating regex
    alter_column($out, $DB, Links => Rating => { type => 'DECIMAL', precision => 4, scale => 2, not_null => 1, default => 0, regex => '^(?:10(?:\.0*)?|\d(?:\.\d*)?)$', form_display => $lang->{prompt_Rating} });

# Update payments_term from CHAR(8) to CHAR(10)
    alter_column($out, $DB, Payments => payments_term => { type => 'CHAR', not_null => 1, size => 10 });

# Fix fk_tables that might have been deleted due to the SQL database overwrite bug
    my %fk_tables = (
        Category => [qw/CatPrice CatLinks CatRelations Editors/],
        Links    => [qw/Payments Changes Reviews CatLinks Verify/],
        Payments => [qw/PaymentLogs/],
        Users    => [qw/Links Changes Reviews Editors Sessions/]
    );
    $out->("Checking fk_tables...\n");
    my $p = $DB->prefix;
    while (my ($table, $tables) = each %fk_tables) {
        my $tb = $DB->table($table);
        my $changed;
        for (@$tables) {
            $tb->_add_fk_table("$p$_") and $changed++;
        }
        if ($changed) {
            $tb->save_state;
            $out->("\t\t$table table's fk_tables repaired\n");
        }
    }
    $out->("\tOkay!\n");

    $out->(DONE '2.2.0' => '2.2.1');
}

sub upgrade__2_1_2__2_2_0 {
# ---------------------------------------------------------------
# Upgrade from 2.1.2 to 2.2.0
#
    my ($out, $cfg) = @_;
    $out->(PERFORM '2.1.2' => '2.2.0');

    import lib $cfg->{admin_root_path};
    require GT::Config;

    # Check to see that the PPC plugin <1.93 is not installed.  Versions prior
    # to 1.93 conflict with Links SQL's 'Payments' table.
    my $plugin_cfg = GT::Config->load("$cfg->{admin_root_path}/Plugins/plugin.cfg");
    if (exists $plugin_cfg->{PPC} and (!$plugin_cfg->{PPC}->{version} or $plugin_cfg->{PPC}->{version} < 1.93)) {
        $out->("Old PPC plugin detected - you must upgrade the PPC plugin to 1.93 or above before upgrading Links SQL.");
        die "Old PPC plugin detected - you must upgrade the PPC plugin to 1.93 or above before upgrading Links SQL.";
    }

    require GT::SQL;
    $Links::DB = my $DB = GT::SQL->new($cfg->{admin_root_path} . '/defs');
    $Links::STASH{clicktrack_cleanup} = 1;
    $Links::STASH{expired_links} = 1;

    my $lang = GT::Config->load("$cfg->{admin_root_path}/templates/admin/language.txt");

    for my $table (qw/Users Links Category/) {
        $out->("Updating $table subclasses...\n");
        # Create a new GT::SQL::Table object manually as I do _not_ want to
        # load the existing subclasses.
        my $t = GT::SQL::Table->new(
            name     => "$DB->{connect}->{PREFIX}$table",
            connect  => $DB->{connect},
            debug    => $DB->{_debug},
            _err_pkg => 'GT::SQL::Table'
        );
        $t->subclass(
            table => { $table => "Links::Table::$table" },
            html  => { $table => "Links::HTML::$table" }
        );
        $t->save_state();
        $out->("\tOkay!\n");
    }

    add_column($out, $DB, Category => Payment_Mode => { type => 'TINYINT', not_null => 1, default => 0, form_size => 1, form_names => [0,1,2,3], form_values => ['Use global settings','Not accepted','Optional','Required'], form_type => 'SELECT', form_display => $lang->{prompt_Payment_Mode} });
    add_column($out, $DB, Category => Payment_Description => { type => 'TEXT', form_display => $lang->{prompt_Payment_Description} });
    add_column($out, $DB, Links => ExpiryDate => { type => 'INT', not_null => 1, default => 0x7fff_ffff, form_display => $lang->{prompt_ExpiryDate}, form_size => 35 });
    add_column($out, $DB, Links => ExpiryCounted => { type => 'TINYINT', not_null => 1, default => 0, form_display => $lang->{prompt_ExpiryCounted}, form_type => 'hidden' });
    add_column($out, $DB, Links => ExpiryNotify  => { type => 'TINYINT', not_null => 1, default => 0, form_display => $lang->{prompt_ExpiryNotify},  form_type => 'hidden' });
    drop_index($out, $DB, Links => 'valndx');
    add_index($out, $DB, Links => {
        valexpndx => [qw/isValidated ExpiryDate/],
        expiryndx => [qw/ExpiryDate ExpiryNotify/],
        expcntndx => [qw/ExpiryCounted ExpiryDate/]
    });

    add_table($out, $DB, "CatPrice",
        cols => [
            cp_id          => { type => 'INT', not_null => 1, unsigned => 1 },
            cp_cat_id_fk   => { type => 'INT', not_null => 1, unsigned => 1 },
            cp_term        => { type => 'CHAR', not_null => 1, size => 10 }, # e.g. 8d, 1m, 2y, 3w, unlimited, etc.
            cp_cost        => { type => 'FLOAT', not_null => 1 },
            cp_type        => { type => 'TINYINT', not_null => 1, unsigned => 1 }, # 0 = signup, 1 = renewal, 2 = recurring
            cp_description => { type => 'TEXT' }
        ],
        pk => 'cp_id',
        ai => 'cp_id',
        fk => { Category => { cp_cat_id_fk => 'ID' } }
    );

    add_table($out, $DB, "Payments",
        cols => [
            payments_id     => { type => 'CHAR', not_null => 1, size => 16 },
            payments_linkid => { type => 'INT', unsigned => 1, not_null => 1 },
            payments_status => { type => 'INT', not_null => 1, default => 0, unsigned => 1 }, # 0 = pending, 1 = completed, 2 = declined, 3 = error
            payments_method => { type => 'CHAR', not_null => 1, size => 25 },
            payments_type   => { type => 'TINYINT', not_null => 1, unsigned => 1 }, # 0 = initial payment, 1 = renewal payment, 2 = recurring payment
            payments_amount => { type => 'FLOAT', not_null => 1 },
            payments_term   => { type => 'CHAR', not_null => 1, size => 8 }, # e.g. 8d, 1m, 2y, 3w, etc.
            payments_start  => { type => 'INT', not_null => 1, unsigned => 1 },
            payments_last   => { type => 'INT', not_null => 1, unsigned => 1 },
        ],
        pk => 'payments_id',
        fk => { Links => { payments_linkid => 'ID' } },
        index => {
            p_sl => ['payments_status', 'payments_last'],
            p_ll => ['payments_linkid', 'payments_last'],
            p_al => ['payments_amount', 'payments_last'],
        }
    );

    add_table($out, $DB, "PaymentLogs",
        cols => [
            paylogs_id          => { type => 'INT', not_null => 1, unsigned => 1 },
            paylogs_payments_id => { type => 'CHAR', not_null => 1, size => 16 },
            paylogs_type        => { type => 'INT', not_null => 1, default => 0, unsigned => 1 }, # 0 = info, 1 = accepted, 2 = declined, 3 = error
            paylogs_time        => { type => 'INT', not_null => 1, unsigned => 1 },
            paylogs_viewed      => { type => 'TINYINT', not_null => 1, default => 0, unsigned => 1 },
            paylogs_text        => { type => 'TEXT' },
        ],
        pk => 'paylogs_id',
        ai => 'paylogs_id',
        fk => { Payments => { paylogs_payments_id => 'payments_id' } },
        index => {
            pl_yt => ['paylogs_type', 'paylogs_time'],
            pl_t => ['paylogs_time']
        }
    );

    recreate_table($out => $DB => ClickTrack => sub { my $table = shift; ($table->pk and @{$table->pk} != 0) },
        cols => [
            LinkID    => { type => 'INT', not_null => 1 },
            IP        => { type => 'CHAR', size => 25, not_null => 1 },
            ClickType => { type => 'ENUM', values => ['Rate', 'Hits','Review'], not_null => 1 },
            ReviewID  => { type => 'INT', not_null => 1, default => 0},
            Created   => { type => 'TIMESTAMP' }
        ],
        unique => {
            ct_licr => ['LinkID', 'IP', 'ClickType','ReviewID']
        },
        index => {
            cndx => ['Created']
        }
    );

    if (-e(my $oldconfig = "$cfg->{admin_root_path}/Links/ConfigData.pm")) {
        $out->("Removing old Links/ConfigData.pm file (has been replaced with Links/Config/Data.pm)...\n");
        require GT::File::Tools;
        my $ret = GT::File::Tools::move($oldconfig, "$oldconfig.old");
        $out->($ret ? "\tOkay!\n" : "\tAn error occured: $!\n");
    }

    $out->(DONE '2.1.2' => '2.2.0');
}

sub upgrade__2_1_1__2_1_2 {
# ---------------------------------------------------------------
# Upgrade from 2.1.1 to 2.1.2
#
    my ($out, $cfg) = @_;
    $out->(PERFORM '2.1.1' => '2.1.2');

# Add session table.
    import lib $cfg->{admin_root_path};
    require GT::SQL;
    my $DB = GT::SQL->new( $cfg->{admin_root_path} . '/defs' );
    add_table($out, $DB, 'Sessions',
        cols => [
            session_id      =>  { type => 'CHAR', size => 32, not_null => 1, binary => '1' },
            session_user_id =>  { type => 'CHAR', not_null => 1 },
            session_date    =>  { type => 'INT',  not_null => 1 },
            session_data    =>  { type => 'TEXT' }
        ],
        pk => 'session_id',
        fk => { Users => { session_user_id => 'Username' } }
    );

    $out->(DONE '2.1.1' => '2.1.2');
}

sub upgrade__2_0_5__2_1_0 {
# ---------------------------------------------------------------
# Upgrade from 2.0.5 to 2.1.0
#
    my ($out, $cfg) = @_;
    $out->(PERFORM '2.0.5' => '2.1.0');

# Add the review table.
    import lib $cfg->{admin_root_path};
    require GT::SQL;
    require GT::Config;
    my $lang  = GT::Config->load( $cfg->{admin_root_path} . '/templates/admin/language.txt' );
    my $DB = GT::SQL->new($cfg->{admin_root_path} . '/defs');

    add_table($out, $DB, 'Reviews',
        cols => [
            ReviewID            =>  { type => 'INT', not_null => 1, unsigned => 1, form_display => $lang->{'prompt_ReviewID'} },
            Review_LinkID       =>  { type => 'INT', not_null => 1, unsigned => 1, regex => '^\d+$', form_display => $lang->{'prompt_Review_LinkID'} },
            Review_Owner        =>  { type => 'CHAR', size => 50, not_null => 1, form_display => $lang->{'prompt_Review_Owner'} },
            Review_Rating       =>  { type => 'SMALLINT', unsigned => 1, not_null => 1, default => 0, regex => '^\d+$', form_display => $lang->{'prompt_Review_Rating'} },
            Review_Date         =>  { type => 'DATE', not_null => 1, form_display => $lang->{'prompt_Review_Date'} },
            Review_Subject      =>  { type => 'CHAR', size => 100, not_null => 1, form_display => $lang->{'prompt_Review_Subject'} },
            Review_Contents     =>  { type => 'TEXT', not_null => 1, form_display => $lang->{'prompt_Review_Contents'} },
            Review_ByLine       =>  { type => 'CHAR', size => 50, form_display => $lang->{'prompt_Review_ByLine'} },
            Review_WasHelpful   =>  { type => 'INT', unsigned => 1, regex => '^\d+$', form_display => $lang->{'prompt_Review_WasHelpful'} },
            Review_WasNotHelpful=>  { type => 'INT', unsigned => 1, regex => '^\d+$', form_display => $lang->{'prompt_Review_WasNotHelpful'} },
            Review_Validated    =>  { type => 'ENUM', values => ['No', 'Yes'], not_null => 1, default => 'No', form_display => $lang->{'prompt_Review_Validated'} },
            Review_GuestName    =>  { type => 'CHAR', size => 75, form_display => $lang->{'prompt_Review_GuestName'} },
            Review_GuestEmail   =>  { type => 'CHAR', size => 75, regex => '^(?:(?:.+\@.+\..+)|\s*)$', form_display => $lang->{'prompt_Review_GuestEmail'} },
        ],
        pk => 'ReviewID',
        ai => 'ReviewID',
        index => { rownerndx => ['Review_Owner'], rdatendx => ['Review_Date'], rlinkndx => ['Review_LinkID'] },
        fk => { Links => { Review_LinkID => 'ID' }, Users => { Review_Owner => 'Username' }}
    );

    add_column($out, $DB, ClickTrack => ReviewID => { type => 'INT', not_null => 1, default => 0 });

# Set default review options.
    my %default_review = (
        user_review_required   => 1,
        reviews_per_page       => 5,
        review_sort_by         => 'Review_Date',
        review_convert_br_tags => 1,
        review_days_old        => 7
    );
    while (my ($k, $v) = each %default_review) {
        $cfg->{$k} = $v unless exists $cfg->{$k};
    }

    $out->(DONE '2.0.5' => '2.1.0');
}

sub upgrade__2_0_3__2_0_4 {
# ---------------------------------------------------------------
# Upgrade from 2.0.3 to 2.0.4.
#
    my ($out, $cfg) = @_;

    $out->(PERFORM '2.0.3' => '2.0.4');

    import lib $cfg->{admin_root_path};
    require GT::SQL;
    my $db = GT::SQL->new($cfg->{admin_root_path} . '/defs');

    add_column($out, $db, Links => Contact_Name => { type => 'CHAR', size => 255 });
    add_column($out, $db, Links => Contact_Email => { type => 'CHAR', size => 255 });
    add_column($out, $db, Category => Category_Template => { type => 'CHAR', size => 40 });
    add_column($out, $db, MailingIndex => messageformat => { type => 'ENUM', values => [qw[text html]], not_null => 1, default => 'text' });

    $out->(DONE '2.0.3' => '2.0.4');
}

1;