# ==================================================================
# Gossamer Links - enhanced directory management system
#
#	Website  : http://gossamer-threads.com/
#	Support  : http://gossamer-threads.com/scripts/support/
#	Revision : $Id: L2S2.pm,v 1.39 2005/04/16 02:11:50 brewt Exp $
#
# Copyright (c) 2001 Gossamer Threads Inc.  All Rights Reserved.
# Redistribution in part or in whole strictly prohibited. Please
# see LICENSE file for full details.
# ==================================================================

package Links::Import::L2S2;

use 5.004_04;
use strict;
use vars qw/$Warning_Code $Critical_Code $Mild_Code $Print_Out/;

use GT::SQL;

sub critical {
    $Critical_Code->(@_);
}

sub warning {
    $Warning_Code->(@_);
}

sub mild_warning {
    ref $Mild_Code eq 'CODE' and $Mild_Code->(@_);
}

sub import_print {
    if (ref $Print_Out eq 'CODE') {
        $Print_Out->(@_);
    }
    else {
        print @_;
    }
}

# Takes 3-4 arguments: hash reference, 2 or 3 code refs
# The hash reference is the options hash for an import.
# The first code reference will be called when a warning occurs.
# The second code reference will be called when a critical error occurs.
# If provided, the third code reference will be called when a mild warning occurs
sub import {
    my $opt = shift;
    return if ref $opt ne 'HASH';
    {
        my $warning = shift;
        return if ref $warning ne 'CODE';
        $Warning_Code = $warning;

        my $critical = shift;
        return if ref $critical ne 'CODE';
        $Critical_Code = $critical;

        my $mild = shift;
        $Mild_Code = $mild if ref $mild eq 'CODE';

        my $output = shift;
        $Print_Out = $output if ref $output eq 'CODE';
    }

    my ($have_email_db,$have_validate_db);

    my $DB = new GT::SQL(def_path => $$opt{destination}, subclass => 0);
    my $e_prefix = $DB->prefix;
    my $e_dbh;
    {
        my $table = $DB->table("Links");
        $table->connect();
        $e_dbh = $table->{driver}->connect();
    }

    local (*LINKS,*CATS,*EMAIL,$@,$!,*VALIDATE);
    my $did = do {
        package Links2::Def::Category; # Avoid namespace pollution
        do "$$opt{source}/category.def";
    };
    !$did and $@ and critical "Cannot parse $$opt{source}/category.def: $@";
    !$did and $! and critical "Cannot open $$opt{source}/category.def: $!";
    open CATS, "<$$opt{source}/data/categories.db" or critical "Unable to open $$opt{source}/data/categories.db: $!";
    $did = do {
        package Links2::Def::Links;
        do "$$opt{source}/links.def";
    };
    !$did and $@ and critical "Cannot parse $$opt{source}/links.def: $@";
    !$did and $! and critical "Cannot open $$opt{source}/links.def: $!";
    open LINKS, "<$$opt{source}/data/links.db" or critical "Unable to open $$opt{source}/data/links.db: $!";
    if (open VALIDATE, "<$$opt{source}/data/validate.db") {
        $have_validate_db = 1;
    }
    else {
        warning "Could not open $$opt{source}/data/validate.db: $!. Non-validated links will not be imported.";
    }
    if (open EMAIL, "$$opt{source}/data/email.db") {
        $have_email_db = 1;
    }
    else {
        warning "Could not open $$opt{source}/data/email.db: $!. No newsletter users will be imported.";
    }

    my %e_standard_cols = (
        Category => { map { ($_ => 1) } qw/ID Name FatherID Full_Name Description Meta_Description Meta_Keywords Header Footer Category_Template Number_of_Links Has_New_Links Has_Changed_Links Newest_Link Timestmp Payment_Mode/},
        Links    => { map { ($_ => 1) } qw/ID Title URL LinkOwner Add_Date Mod_Date Description Contact_Name Contact_Email Hits isNew isChanged isPopular isValidated Rating Votes Status Date_Checked Timestmp ExpiryDate ExpiryCounted ExpiryNotify/},
    );

    my %e_non_standard_cols;
    for my $table (keys %e_standard_cols) {
        my %cols = $DB->table($table)->cols;
        for (grep !$e_standard_cols{$table}{$_}, keys %cols) {
            $e_non_standard_cols{$table}{$_} = 1;
        }
    }

    my %i_standard_cols = (
        Category => { map { ($_ => 1) } qw/ID Name Description Related Header Footer/,'Meta Description','Meta Keywords' },
        Links    => { map { ($_ => 1) } qw/ID Title URL Date Category Description Hits isNew isPopular Rating Votes ReceiveMail/,'Contact Name','Contact Email'}
    );

    my %i_non_standard_cols;
    $i_non_standard_cols{Links} = { map { !$i_standard_cols{Links}{$_} ? ($_ => 1) : () } keys %Links2::Def::Links::db_def };
    $i_non_standard_cols{Category} = { map { !$i_standard_cols{Category}{$_} ? ($_ => 1) : () } keys %Links2::Def::Category::db_def };

    my $alt_categories = delete $i_non_standard_cols{Links}{AltCategories};

    my $Links_counter;
    my $Category_counter;
    my $odbc = 0;
    if ($DB->table('Links')->{connect}->{driver} eq 'ODBC') {
        $odbc = 1;
    }

    if ($$opt{clear_tables}) {
    # Delete everything from all tables, EXCEPT for the `admin' user from the Users table
        $e_dbh->do("DELETE FROM ${e_prefix}Users WHERE Username <> 'admin'") or critical "Unable to delete all existing users: ".$e_dbh->errstr;
        for (qw/Links Category CatLinks CatRelations Category_Score_List
            Category_Word_List ClickTrack Editors EmailMailings EmailTemplates
            Links_Score_List Links_Word_List MailingIndex MailingList
            MailingListIndex Sessions Verify/) {
            $e_dbh->do("DELETE FROM $e_prefix$_");
        }
        unless ($$opt{straight_import}) {
            $Links_counter = $Category_counter = 0;
        }
    }
    else {
        my $sth = $e_dbh->prepare("SELECT MAX(ID) FROM ${e_prefix}Links") or critical "Unable to prepare query `SELECT MAX(ID) FROM ${e_prefix}Links': ".$e_dbh->errstr;
        $sth->execute or critical "Unable to execute query `SELECT MAX(ID) FROM ${e_prefix}Links': ".$sth->errstr;
        $Links_counter = $sth->fetchrow_array;
        $sth->finish();

        $sth = $e_dbh->prepare("SELECT MAX(ID) FROM ${e_prefix}Category") or critical "Unable to prepare query `SELECT MAX(ID) FROM ${e_prefix}Category': ".$e_dbh->errstr;
        $sth->execute or critical "Unable to execute query `SELECT MAX(ID) FROM ${e_prefix}Category': ".$sth->errstr;
        $Category_counter = $sth->fetchrow_array;
        $sth->finish();
    }

# Subscribe users - these users receive the newsletter.
    if ($have_email_db) {
        my $count_users = $e_dbh->prepare("SELECT COUNT(*) FROM ${e_prefix}Users WHERE Email = ?");
        my $add_user = $e_dbh->prepare("INSERT INTO ${e_prefix}Users (Name, Username, Password, Email, ReceiveMail) VALUES (?, ?, ?, ?, 'Yes')");
        my $give_newsletter = $e_dbh->prepare("UPDATE ${e_prefix}Users SET ReceiveMail = 'Yes' WHERE Email = ?");

        my $sub_imported = 0;
        import_print "\nImporting Subscribe users (newsletter receivers) ...\n";
        while (<EMAIL>) {
            chomp;
            my ($email,$name) = split /\|/;
            $name ||= "";
            $count_users->execute($email) or warning("Unable to count users with email $email: ".$count_users->errstr), next;
            if ($count_users->fetchrow_array) {
                $give_newsletter->execute($email) or warning("Unable to set ReceiveMail = 'Yes' for user with e-mail $email: ".$give_newsletter->errstr),--$sub_imported;
            }
            else { # User doesn't already exist
                $add_user->execute($name, $email, random_pass(), $email) or warning("Unable to insert user $email: ".$add_user->errstr),--$sub_imported;
            }
            import_print "$sub_imported\n" unless ++$sub_imported % 500;
        }
        import_print "$sub_imported Subscribed users imported.\n";
    }


# Categories
    my %cat_map; # $cat_map{name} = new_id
    my @num_of_links; # $num_of_links[category_id] = (the number of links in that category)

    {
        my @cat_get_cols = ('ID','Name','Related',       'Description','Meta Description','Meta Keywords','Header','Footer');
        my $cat_ins_cols = "(ID, Name, FatherID, Full_Name, Description, Meta_Description, Meta_Keywords, Header, Footer";
        my $cat_ins_vals = "(?, ?, ?, ?, ?, ?, ?, ?, ?";

        # Build up extra fields that exist in both old and new Category tables
        for (keys %{$e_non_standard_cols{"${e_prefix}Category"}}) {
            if ($i_non_standard_cols{Category}{$_}) {
                $cat_ins_cols .= ", $_";
                $cat_ins_vals .= ", ?";
                push @cat_get_cols, $_;
            }
            else {
                mild_warning("Custom destination column `${e_prefix}Category.$_' has no equivelant import column. It will contain the default values for the column");
            }
        }

        for (grep !$e_non_standard_cols{"${e_prefix}Category"}{$_}, keys %{$i_non_standard_cols{Category}}) {
            if ($opt->{create_columns}) {
                if (/\W/) {
                    critical "Custom import column `Category.$_' cannot be imported because is is not a valid column name. You will need to rename the column name in the def file and in any relevant templates to a new name consisting only of letters, numbers, and the _ character.";
                    next;
                }
                mild_warning("Custom import column `Category.$_' had no destination equivelant. A destination column will be created");
                my $editor = $DB->editor("Category");
                my @def = @{$Links2::Def::Category::db_def{$_}};
                $editor->add_col(
                    $_,
                    {
                        type                  => ((uc $def[1] eq 'ALPHA' and $def[3] > 255) ? 'TEXT' : 'CHAR'),
                        ($def[2] ? (form_size => ((index($def[2],"x") > -1) ? [split(/x/,$def[2],2)] : $def[2])) : ()),
                        size                  => $def[3],
                        ($def[4] ? (not_null  => 1)       : ()),
                        ($def[5] ? (default   => $def[5]) : ()),
                        ($def[6] ? (regex     => $def[6]) : ()),
                    }
                );
                $cat_ins_cols .= ", $_";
                $cat_ins_vals .= ", ?";
                push @cat_get_cols, $_;

                $e_non_standard_cols{"${e_prefix}Category"}{$_} = 1;
            }
            else {
                warning("Custom import column `Category.$_' has no destination equivelant. It will be ignored");
            }
        }
        $cat_ins_cols .= ")";
        $cat_ins_vals .= ")";

        my $add_cat_relation = $e_dbh->prepare("INSERT INTO ${e_prefix}CatRelations (CategoryID, RelatedID) VALUES (?, ?)") or critical "Unable to prepare query `INSERT INTO ${e_prefix}CatRelations (CategoryID, RelatedID) VALUES (?, ?)': ".$e_dbh->errstr;
        my $count_cats_sth = $e_dbh->prepare("SELECT COUNT(*) FROM ${e_prefix}Category WHERE Full_Name = ?") or critical("Unable to prepare query `SELECT COUNT(*) FROM ${e_prefix}Category WHERE Full_Name = ?': ".$e_dbh->errstr);
        my $cat_ins_sth = $odbc
            ? ($e_dbh->prepare("SET IDENTITY_INSERT ${e_prefix}Category ON; INSERT INTO ${e_prefix}Category $cat_ins_cols VALUES $cat_ins_vals") or critical("Unable to prepare query `INSERT INTO ${e_prefix}Category $cat_ins_cols VALUES $cat_ins_vals': ".$e_dbh->errstr))
            : ($e_dbh->prepare("INSERT INTO ${e_prefix}Category $cat_ins_cols VALUES $cat_ins_vals") or critical("Unable to prepare query `INSERT INTO ${e_prefix}Category $cat_ins_cols VALUES $cat_ins_vals': ".$e_dbh->errstr));

        my $cat_ins_simple_sth = $odbc
            ? ($e_dbh->prepare("SET IDENTITY_INSERT ${e_prefix}Category ON; INSERT INTO ${e_prefix}Category (ID, Name, Full_Name, FatherID) VALUES (?, ?, ?, ?)") or critical("Unable to prepare query `INSERT INTO ${e_prefix}Category (ID, Name, Full_Name, FatherID) VALUES (?, ?, ?, ?)': ".$e_dbh->errstr))
            : ($e_dbh->prepare("INSERT INTO ${e_prefix}Category (ID, Name, Full_Name, FatherID) VALUES (?, ?, ?, ?)") or critical("Unable to prepare query `INSERT INTO ${e_prefix}Category (ID, Name, Full_Name, FatherID) VALUES (?, ?, ?, ?)': ".$e_dbh->errstr));

        my $get_id_sth = $e_dbh->prepare("SELECT ID FROM ${e_prefix}Category WHERE Full_Name = ?") or critical("Unable to prepare query `SELECT ID FROM ${e_prefix}Category WHERE Full_Name = ?': ".$e_dbh->errstr);

        {
            my ($no_warning) = (
                $Links2::Def::Category::db_delim,
                $Links2::Def::Links::db_delim
            )
        }

        my @cat_relations;

        my $cat_imported = 0;
        import_print "\nImporting Categories ...\n";
        my @cat_data;
        while (my $row = get_rec(\*CATS,'Category',\%Links2::Def::Category::db_def,\$Links2::Def::Category::db_delim,\@cat_get_cols)) {
            push @cat_data, $row if ref $row eq 'ARRAY';
        }

        @cat_data = sort { $a->[0] cmp $b->[0] } @cat_data;

        my @missing_cats;
        my %missing_cats;
        for my $row (@cat_data) {
            $row = [@$row];
            my $old_id = shift @$row;
            my $new_id = $$opt{straight_import} ? $old_id : ++$Category_counter;
            my ($name) = (my $full_name = shift @$row) =~ m[([^/]*)\Z];
            unless (defined $name and length $name) {
                $Category_counter-- unless $$opt{straight_import};
                warning "Cannot insert Category $full_name because it is an invalid name";
                next;
            }
            my ($father_full_name) = $full_name =~ m[\A(.*)/];
            my $father_id;
            if (not defined $father_full_name) {
                $father_id = 0;
            }
            else {
                $get_id_sth->execute($father_full_name) or critical "Unable to execute query `SELECT ID FROM ${e_prefix}Category WHERE Full_Name = ?': ".$get_id_sth->errstr;
                if (my $ar = $get_id_sth->fetchrow_arrayref()) {
                    $father_id = $ar->[0] || 0;
                }
                else {
                    my $ins_pos = @missing_cats;
                    if ($$opt{create_missing_categories}) {
                        unless ($missing_cats{$father_full_name}++) {
                            splice @missing_cats, $ins_pos, 0, $father_full_name;
                            mild_warning "$father_full_name is needed for category $full_name and does not exist. It will be created";
                            my $fn = $father_full_name;
                            while ($fn =~ s[/[^/]*\Z][]) {
                                $count_cats_sth->execute($fn) or critical "Unable to execute query `SELECT COUNT(*) FROM ${e_prefix}Category WHERE Full_Name = ?': ".$count_cats_sth->errstr;
                                if ($count_cats_sth->fetchrow_array or $missing_cats{$fn}++) { # It exists
                                    $count_cats_sth->finish;
                                    last;
                                }
                                else {
                                    splice @missing_cats, $ins_pos, 0, $fn;
                                    mild_warning "$fn is needed for category $full_name and does not exist. It will be created";
                                    $count_cats_sth->finish;
                                }
                            }
                        }
                        else {
                            mild_warning "$father_full_name is also needed for category $full_name and is already in the queue to be created.";
                        }
                    }
                    else {
                        warning "No father row found for $full_name! This may be a serious error as $full_name should probably have a father category";
                    }
                    $father_id = 0;
                }
                $get_id_sth->finish;
            }

            $cat_relations[$new_id] = shift @$row; # This has to be dealt with later.

            if ($$opt{data_integrity}) {
                $count_cats_sth->execute($full_name) or critical "Unable to execute query `SELECT COUNT(*) FROM ${e_prefix}Category WHERE Full_Name = ?': ".$count_cats_sth->errstr;
                unless ($count_cats_sth->fetchrow_array) {
                    unless ($cat_ins_sth->execute($new_id,$name,$father_id,$full_name,@$row)) {
                        $Category_counter-- unless $$opt{straight_import};
                        warning "Unable to insert category `$full_name' (SQL query: `INSERT INTO ${e_prefix}Category $cat_ins_cols VALUES $cat_ins_vals'): ".$cat_ins_sth->errstr;
                        $count_cats_sth->finish;
                        next;
                    }
                    import_print "$cat_imported\n" unless ++$cat_imported % 500;
                    $cat_map{$full_name} = $new_id;
                    $num_of_links[$new_id] = 0;
                    $count_cats_sth->finish;
                }
                else {
                    --$Category_counter unless $$opt{straight_import};
                    mild_warning("Duplicate category found ($full_name) and skipped");
                    $count_cats_sth->finish;
                    next;
                }
            }
            elsif (!$cat_map{$full_name}) {
                unless ($cat_ins_sth->execute($new_id,$name,$father_id,$full_name,@$row)) {
                    --$Category_counter unless $$opt{straight_import};
                    warning("Unable to insert category `$full_name' (SQL query: `INSERT INTO ${e_prefix}Category $cat_ins_cols VALUES $cat_ins_vals'): ".$cat_ins_sth->errstr);
                    next;
                }
                import_print "$cat_imported\n" unless ++$cat_imported % 500;
                $cat_map{$full_name} = $new_id;
                $num_of_links[$new_id] = 0;
            }
            else {
                --$Category_counter unless $$opt{straight_import};
                mild_warning("Duplicate category found ($full_name) and skipped");
                next;
            }
        }
        my $missing_cats;
        if ($$opt{create_missing_categories} and @missing_cats) {
            my $counter = $e_dbh->prepare("SELECT MAX(ID) FROM ${e_prefix}Category");
            $counter->execute();
            my $ins_id = $counter->fetchrow_array();
            my $update_sub_cats = $e_dbh->prepare("UPDATE ${e_prefix}Category SET FatherID = ? WHERE Full_Name LIKE ? AND Full_Name NOT LIKE ?") or critical "Unable to prepare query `UPDATE ${e_prefix}Category SET FatherID = ? WHERE Full_Name LIKE ? AND Full_Name NOT LIKE ?': ".$e_dbh->errstr;
            for (@missing_cats) {
                if ($cat_map{$_}) { # Already exists
                    $update_sub_cats->execute($cat_map{$_},"$_/%","$_/%/%") or critical "Unable to execute query `UPDATE ${e_prefix}Category SET FatherID = ? WHERE Full_Name LIKE ? and Full_Name NOT LIKE ?': ".$update_sub_cats->errstr;
                    next;
                }
                my ($name) = m[([^/]*)\Z];
                my ($father_full) = m[\A(.*)/];
                my $father_id;
                if ($father_full and exists $cat_map{$father_full}) {
                    $father_id = $cat_map{$father_full};
                }
                elsif ($father_full) {
                    $get_id_sth->execute($father_full) or critical "Unable to execute query `SELECT ID FROM ${e_prefix}Category WHERE Full_Name = ?': ".$get_id_sth->errstr;
                    $father_id = $get_id_sth->fetchrow_array;
                }
                else { # Must be a category of root
                    $father_id = 0;
                }
                $cat_ins_simple_sth->execute(++$ins_id,$name,$_,$father_id) or critical "Unable to create missing category $_: ".$cat_ins_simple_sth->errstr;
                $cat_map{$_} = $ins_id;
                $update_sub_cats->execute($ins_id,"$_/%","$_/%/%") or critical "Unable to execute query `UPDATE ${e_prefix}Category SET FatherID = ? WHERE Full_Name LIKE ? and Full_Name NOT LIKE ?': ".$update_sub_cats->errstr;
                $missing_cats++;
            }
        }

        import_print "$cat_imported Categories imported";
        import_print ", $missing_cats missing categories created" if $missing_cats;
        import_print ".\n";

# Category Relations
        import_print "\nImporting Category Relations ...\n";
        my $cat_rel_imported = 0;
        for my $cat_id (0..$#cat_relations) {
            next unless defined $cat_relations[$cat_id];
            my @cats = split /\Q$Links2::Def::Category::db_delim/, $cat_relations[$cat_id];
            for (@cats) {
                $get_id_sth->execute($_) or critical "Unable to execute query `SELECT ID FROM ${e_prefix}Category WHERE Full_Name = ? <- $_': ".$get_id_sth->errstr;
                my $rel_id = $get_id_sth->fetchrow_array;
                if (defined $rel_id) {
                    unless ($add_cat_relation->execute($cat_id,$rel_id)) {
                        warning "Unable to execute query `INSERT INTO ${e_prefix}CatRelations (CategoryID, RelatedID) VALUES (?, ?)': ".$add_cat_relation->errstr;
                    }
                    else {
                        import_print "$cat_rel_imported\n" unless ++$cat_rel_imported % 500;
                    }
                }
                else {
                    warning "Unable to add category relation for category with ID $cat_id and `$_'. Reason: Category `$_' not found in database.";
                }
                $get_id_sth->finish;
            }
        }
        import_print "$cat_rel_imported Category Relations imported.\n";
    }
# Links
    {
        my @links_get_cols = ('ID','Category','Date','Contact Name','Contact Email','ReceiveMail',       qw/Title  URL  Description  Hits  isNew  isPopular  Rating  Votes/);
        my $links_ins_cols = "(ID, LinkOwner, isValidated, Add_Date, Mod_Date, Contact_Name, Contact_Email, Title, URL, Description, Hits, isNew, isPopular, Rating, Votes";
        my $links_ins_vals = "(?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?";

        for (keys %{$e_non_standard_cols{"${e_prefix}Links"}}) {
            if ($i_non_standard_cols{Links}{$_}) {
                $links_ins_cols .= ", $_";
                $links_ins_vals .= ", ?";
                push @links_get_cols, $_;
            }
            else {
                mild_warning("Custom destination column `${e_prefix}Links.$_' has no equivelant import column. It will contain the default values for the column");
            }
        }

        for (grep !$e_non_standard_cols{"${e_prefix}Links"}{$_}, keys %{$i_non_standard_cols{Links}}) {
            if ($opt->{create_columns}) {
                mild_warning("Custom import column `Links.$_' had no destination equivelant. A destination column will be created");
                my $editor = $DB->editor("Links");
                my @def = @{$Links2::Def::Links::db_def{$_}};
                $editor->add_col(
                    $_,
                    {
                        type                  => ((uc $def[1] eq 'ALPHA' and $def[3] > 255) ? 'TEXT' : 'CHAR'),
                        ($def[2] ? (form_size => ((index($def[2],"x") > -1) ? [split(/x/,$def[2],2)] : $def[2])) : ()),
                        size                  => $def[3],
                        ($def[4] ? (not_null  => 1)       : ()),
                        ($def[5] ? (default   => $def[5]) : ()),
                        ($def[6] ? (regex     => $def[6]) : ())
                    }
                );
                $links_ins_cols .= ", $_";
                $links_ins_vals .= ", ?";
                push @links_get_cols, $_;

                $e_non_standard_cols{"${e_prefix}Links"}{$_} = 1;
            }
            else {
                warning("Custom import column `Links.$_' has no destination equivelant. It will be ignored");
            }
        }
        $links_ins_cols .= ")";
        $links_ins_vals .= ")";

        unshift @links_get_cols, "AltCategories" if $alt_categories;

        my $user_ins_sth = $e_dbh->prepare("INSERT INTO ${e_prefix}Users (Password, Username, Email, Name, ReceiveMail, Status) VALUES (?, ?, ?, ?, ?, 'Registered')") or critical("Unable to prepare query `INSERT INTO ${e_prefix}Users (Username, Email, Name, ReceiveMail, Status) VALUES (?, ?, ?, ?, ?, 'Registered')': ".$e_dbh->errstr);
        my $cat_links_sth = $e_dbh->prepare("INSERT INTO ${e_prefix}CatLinks (LinkID, CategoryID) VALUES (?, ?)") or critical("Unable to prepare query `INSERT INTO ${e_prefix}CatLinks (LinkID, CategoryID) VALUES (?, ?)': ".$e_dbh->errstr);
        my $insert_link_sth = $odbc
            ? ($e_dbh->prepare("SET IDENTITY_INSERT ${e_prefix}Links ON; INSERT INTO ${e_prefix}Links $links_ins_cols VALUES $links_ins_vals") or critical("Unable to prepare query `INSERT INTO ${e_prefix}Links $links_ins_cols VALUES $links_ins_vals': ".$e_dbh->errstr))
            : ($e_dbh->prepare("INSERT INTO ${e_prefix}Links $links_ins_cols VALUES $links_ins_vals") or critical("Unable to prepare query `INSERT INTO ${e_prefix}Links $links_ins_cols VALUES $links_ins_vals': ".$e_dbh->errstr));


        my $user_count_sth = $e_dbh->prepare("SELECT COUNT(*) FROM ${e_prefix}Users WHERE Email = ?") or critical("Unable to prepare query `SELECT COUNT(*) FROM ${e_prefix}Users WHERE Email = ?': ".$e_dbh->errstr);
        my $username_sth = $e_dbh->prepare("SELECT Username FROM ${e_prefix}Users WHERE Email = ?") or critical("Unable to prepare query `SELECT Username FROM ${e_prefix}Users WHERE Email = ?': ".$e_dbh->errstr);

        # What other than the Name and ReceiveMail can be updated here?
        my $user_mod_sth = $e_dbh->prepare("UPDATE ${e_prefix}Users SET Name = ?, ReceiveMail = ? WHERE Email = ?") or critical "Unable to prepare query `UPDATE ${e_prefix}Users SET Name = ?, ReceiveMail = ? WHERE Email = ?': ".$e_dbh->errstr;

        my $num_links_sth = $e_dbh->prepare("UPDATE ${e_prefix}Category SET Number_of_Links = ? WHERE ID = ?") or critical "Unable to prepare query `UPDATE ${e_prefix}Category SET Number_of_Links = ? WHERE ID = ?': ".$e_dbh->errstr;

        my ($count_cats_sth,$get_cat_id_sth,$cat_ins_simple_sth);
        my $ins_id;
        if ($$opt{create_missing_categories}) {
            $count_cats_sth = $e_dbh->prepare("SELECT COUNT(*) FROM ${e_prefix}Category WHERE Full_Name = ?") or critical "Unable to prepare query `SELECT COUNT(*) FROM ${e_prefix}Category WHERE Full_Name = ?': ".$e_dbh->errstr;
            $get_cat_id_sth = $e_dbh->prepare("SELECT ID FROM ${e_prefix}Category WHERE Full_Name = ?") or critical "Unable to prepare query `SELECT ID FROM ${e_prefix}Category WHERE Full_Name = ?': ".$e_dbh->errstr;
            $cat_ins_simple_sth = $odbc
                ? ($e_dbh->prepare("SET IDENTITY_INSERT ${e_prefix}Category ON; INSERT INTO ${e_prefix}Category (ID, Name, Full_Name, FatherID) VALUES (?, ?, ?, ?)") or critical "Unable to prepare query `INSERT INTO ${e_prefix}Category (ID, Name, Full_Name, FatherID) VALUES (?, ?, ?, ?)': ".$e_dbh->errstr)
                : ($e_dbh->prepare("INSERT INTO ${e_prefix}Category (ID, Name, Full_Name, FatherID) VALUES (?, ?, ?, ?)") or critical "Unable to prepare query `INSERT INTO ${e_prefix}Category (ID, Name, Full_Name, FatherID) VALUES (?, ?, ?, ?)': ".$e_dbh->errstr);
            my $counter = $e_dbh->prepare("SELECT MAX(ID) FROM ${e_prefix}Category");
            $counter->execute();
            $ins_id = $counter->fetchrow_array();
        }

        import_print "\nImporting Links ...\n";
        my $links_imported = 0;
        my $missing_cats = 0;
        my @more_needed; # This will hold any missing categories (such as A/B in A/B/C)
  LINK: while (my $row = get_rec(\*LINKS,'Links',\%Links2::Def::Links::db_def,\$Links2::Def::Links::db_delim,\@links_get_cols)) {
            $row = [@$row]; # Remove aliasing
            my $alt_cats;
            $alt_cats = shift @$row if $alt_categories;
            my ($id, $cat_name, $date, $contact_name, $contact_email, $receive_mail) = splice @$row,0,6;
            unshift @$row, $contact_name, $contact_email;
            $date = convert_date($date) or warning("Invalid date for link with ID $id. Link skipped."),next;
            $id = ++$Links_counter unless $$opt{straight_import};
            my @category_alternates;
            if ($alt_categories) {
                @category_alternates = split /\Q$Links2::Def::Links::db_delim/, $alt_cats;
                for (@category_alternates) { y/_/ / }
                my %dups;
                # Get rid of duplicates
                @category_alternates = grep !$dups{$_}++, @category_alternates;
            }
            my @cats = ($cat_name,@category_alternates);
            my @cat_ids = @cat_map{@cats};
            my $bad_cats = 0;
            for my $j (0..$#cats) {
                my $cat_id = $cat_ids[$j];
                my $cat_name = $cats[$j];
                unless (defined $cat_id) {
                    if ($$opt{create_missing_categories} and $cat_name) {
                        my @needed = my $fn = $cat_name;
                        while ($fn =~ s[/[^/]*\Z][]) {
                            $count_cats_sth->execute($fn) or critical "Unable to execute query `SELECT COUNT(*) FROM ${e_prefix}Category WHERE Full_Name = ?': ".$count_cats_sth->errstr;
                            if ($count_cats_sth->fetchrow_array) { # It exists
                                $count_cats_sth->finish;
                                last;
                            }
                            else {
                                $count_cats_sth->finish;
                                unshift @needed, $fn;
                            }
                        }
                        for (@needed) {
                            my ($name) = m[([^/]+)\Z];
                            unless ($name) {
                                warning "Unable to create category $_ because it is an invalid name.";
                                $bad_cats++;
                                last;
                            }
                            mild_warning("Creating category $_ as it is needed by link ID $id");
                            my ($father_full) = m[\A(.*)/];
                            my $father_id;
                            if ($father_full) {
                                $get_cat_id_sth->execute($father_full) or critical "Unable to execute query `SELECT ID FROM ${e_prefix}Category WHERE Full_Name = ?': ".$get_cat_id_sth->errstr;
                                $father_id = $get_cat_id_sth->fetchrow_array;
                                $get_cat_id_sth->finish;
                            }
                            else { # Must be a root category
                                $father_id = 0;
                            }
                            $cat_ins_simple_sth->execute(++$ins_id,$name,$_,$father_id) or critical "Unable to create missing category $_: ".$cat_ins_simple_sth->errstr;
                            $cat_map{$_} = $ins_id;
                            $cat_ids[$j] = $ins_id;
                            $missing_cats++;
                        }
                    }
                    else {
                        $bad_cats++;
                    }
                }
            }
            if ($bad_cats == @cat_ids) { # Between the category and the alternate categories, there has to be at least ONE good one.
                if (@cat_ids == 1) {
                    warning "Invalid category `$cat_ids[0]' for link $$row[0] (ID: $id, line $.). Link skipped";
                    next LINK;
                }
                else {
                    warning "No valid categories ($cat_name @category_alternates) for link $$row[0] (ID: $id, line $.). Link skipped";
                    next LINK;
                }
            }
            my $username;
            $user_count_sth->execute($contact_email) or warning("Unable to execute query `SELECT COUNT(*) FROM ${e_prefix}Users WHERE Email = ?': ".$user_count_sth->errstr);
            if ($user_count_sth->fetchrow_arrayref()->[0]) { # This e-mail address already exists
                $user_mod_sth->execute($contact_name, ($receive_mail eq 'Yes' ? 'Yes' : 'No'), $contact_email) or warning("Unable to execute query `UPDATE ${e_prefix}Users SET Name = ?, ReceiveMail = ? WHERE Email = ?': ".$user_mod_sth->errstr);
                $username_sth->execute($contact_email) or warning("Unable to execute query: ".$username_sth->errstr);
                $username = $username_sth->fetchrow_arrayref()->[0];
                $username_sth->finish;
            }
            elsif ($contact_email) {
                $user_ins_sth->execute('', ($contact_email) x 2, (defined $contact_name ? $contact_name : ""), ($receive_mail eq 'Yes' ? 'Yes' : 'No')) or warning("Unable to execute query `INSERT INTO ${e_prefix}Users (Username, Email, Name, ReceiveMail, Status) VALUES (?, ?, ?, ?, ?, 'Registered')': ".$user_ins_sth->errstr);
                $username = $contact_email;
            }
            else {
                mild_warning("Not enough information to add a user for link `".($$row[0] or '<unknown>')." (URL: ".($$row[1] or "<none>")."). Setting link owner to `admin'");
                $username = 'admin';
            }
            $user_count_sth->finish;
            if ($insert_link_sth->execute($id,$username,'Yes',$date,$date,@$row)) {
                for my $cat_id (@cat_ids) {
                    $cat_links_sth->execute($id,$cat_id) or warning "Unable to execute query `INSERT INTO ${e_prefix}CatLinks (LinkID, CategoryID) VALUES (?, ?)': ".$cat_links_sth->errstr;
                    $num_of_links[$cat_id]++;
                }
                import_print "$links_imported\n" unless ++$links_imported % 500;
            }
            else {
                $Links_counter-- unless $$opt{straight_import};
                warning("Unable to insert link `$$row[0]' (SQL query: `INSERT INTO ${e_prefix}Links $links_ins_cols VALUES $links_ins_vals'): ".$insert_link_sth->errstr);
            }
        }
        import_print "$links_imported records from 'Links' imported.\n";

        if ($have_validate_db) {
            $links_imported = 0;
            import_print "Importing records from 'Validate'.\n";

      LINK: while(my $row = get_rec(\*VALIDATE,'Links',\%Links2::Def::Links::db_def,\$Links2::Def::Links::db_delim,\@links_get_cols)) {
                $row = [@$row]; # Remove aliasing
                my $alt_cats;
                $alt_cats = shift @$row if $alt_categories;
                my ($id, $cat_name, $date, $contact_name, $contact_email, $receive_mail) = splice @$row,0,6;
                unshift @$row, $contact_name, $contact_email;
                $date = convert_date($date) or warning("Invalid date `$date' for link with ID $id. Link skipped."),next;
                $id = ++$Links_counter unless $$opt{straight_import};

                my @category_alternates;
                if ($alt_categories) {
                    @category_alternates = split /\Q$Links2::Def::Links::db_delim/, $alt_cats;
                }
                my @cats = ($cat_name,@category_alternates);
                my @cat_ids = @cat_map{@cats};
                my $bad_cats = 0;
                for (0..$#cats) {
                    my $cat_id = $cat_ids[$_];
                    my $cat_name = $cats[$_];
                    unless (defined $cat_id) {
                        if ($$opt{create_missing_categories} and $cat_name) {
                            my @needed = my $fn = $cat_name;
                            while ($fn =~ s[/[^/]*\Z][]) {
                                $count_cats_sth->execute($fn) or critical "Unable to execute query `SELECT COUNT(*) FROM ${e_prefix}Category WHERE Full_Name = ?': ".$count_cats_sth->errstr;
                                if ($count_cats_sth->fetchrow_array) { # It exists
                                    $count_cats_sth->finish;
                                    last;
                                }
                                else {
                                    $count_cats_sth->finish;
                                    unshift @needed, $fn;
                                }
                            }
                            for (@needed) {
                                my ($name) = m[([^/]+)\Z];
                                unless ($name) {
                                    warning "Unable to create category $_ because it is an invalid name.";
                                    $bad_cats++;
                                    last;
                                }
                                mild_warning("Creating category $_ as it is needed by link ID $id");
                                my ($father_full) = m[\A(.*)/];
                                my $father_id;
                                if ($father_full) {
                                    $get_cat_id_sth->execute($father_full) or critical "Unable to execute query `SELECT ID FROM ${e_prefix}Category WHERE Full_Name = ?': ".$get_cat_id_sth->errstr;
                                    $father_id = $get_cat_id_sth->fetchrow_array;
                                    $get_cat_id_sth->finish;
                                }
                                else { # Must be a root category
                                    $father_id = 0;
                                }
                                $cat_ins_simple_sth->execute(++$ins_id,$name,$_,$father_id) or critical "Unable to create missing category $_: ".$cat_ins_simple_sth->errstr;
                                $cat_map{$_} = $ins_id;
                                $cat_id = $ins_id;
                                $missing_cats++;
                            }
                        }
                        else {
                            $bad_cats++;
                        }
                    }
                }
                if ($bad_cats == @cat_ids) { # Between the category and the alternate categories, there has to be at least ONE good one.
                    if (@cat_ids == 1) {
                        warning "Invalid category `$cat_ids[0]' for link $$row[0] (ID: $id, line $.). Link skipped";
                        next LINK;
                    }
                    else {
                        warning "No valid categories ($cat_name @category_alternates) for link $$row[0] (ID: $id, line $.). Link skipped";
                        next LINK;
                    }
                }

                my $username;
                $user_count_sth->execute($contact_email) or warning("Unable to execute query `SELECT COUNT(*) FROM ${e_prefix}Users WHERE Email = ?': ".$user_count_sth->errstr);
                if ($user_count_sth->fetchrow_arrayref()->[0]) { # This e-mail address already exists
                    $user_mod_sth->execute($contact_name, ($receive_mail eq 'Yes' ? 'Yes' : 'No'), $contact_email) or warning("Unable to execute query `UPDATE ${e_prefix}Users SET Name = ?, ReceiveMail = ? WHERE Email = ?': ".$user_mod_sth->errstr);
                    $username_sth->execute($contact_email) or warning("Unable to execute query: ".$username_sth->errstr);
                    $username = $username_sth->fetchrow_arrayref()->[0];
                    $username_sth->finish;
                }
                elsif ($contact_email) {
                    $user_ins_sth->execute('', ($contact_email) x 2, (defined $contact_name ? $contact_name : ""), ($receive_mail eq 'Yes' ? 'Yes' : 'No')) or warning("Unable to execute query `INSERT INTO ${e_prefix}Users (Username, Email, Name, ReceiveMail, Status) VALUES (?, ?, ?, ?, ?, 'Registered')': ".$user_ins_sth->errstr);
                    $username = $contact_email;
                }
                else {
                    mild_warning("Not enough information to add a user for link `".($$row[0] or '<unknown>')." (URL: ".($$row[1] or "<none>")."). Setting link owner to `admin'");
                    $username = 'admin';
                }
                $user_count_sth->finish;
                if ($insert_link_sth->execute($id,$username,'No',$date,$date,@$row)) {
                    for my $cat_id (@cat_ids) {
                        next if (! defined $cat_id);
                        $cat_links_sth->execute($id,$cat_id) or warning "Unable to execute query `INSERT INTO ${e_prefix}CatLinks (LinkID, CategoryID) VALUES (?, ?)': ".$cat_links_sth->errstr;
                        $num_of_links[$cat_id]++;
                    }
                    import_print "$links_imported\n" unless ++$links_imported % 500;
                }
                else {
                    $Links_counter-- unless $$opt{straight_import};
                    warning("Unable to insert link `$$row[0]' (SQL query: `INSERT INTO ${e_prefix}Links $links_ins_cols VALUES $links_ins_vals'): ".$insert_link_sth->errstr);
                }
            }
            import_print "$links_imported records from 'Validate' imported.\n";
        }

        import_print "$missing_cats categories have been created due to missing categories for links\n" if $missing_cats;

        for (grep $num_of_links[$_], 0..$#num_of_links) {
            $num_links_sth->execute($num_of_links[$_],$_) or warning "Unable to execute query `UPDATE ${e_prefix}Category SET Number_of_Links = ? WHERE ID = ?': ".$num_links_sth->errstr;
        }
    }
    $e_dbh->disconnect;
    import_print "\nNOTE: You must run Rebuild Cat. tree, Repair Tables, and Rebuild Search after performing an import!\n";
}

# Takes 4 options: a glob ref containing an opened filehandle, a table name, a
# hash ref, a scalar delimiter, and (optionally) an array of fields to return.
# The table name should be 'Links', 'CatRelations', 'Category', or 'Sessions'.
# If you give it the fields, it will come back with an array (or array ref) of
# the values for those fields in the order specified.
# Otherwise, it will return a hash ref (or hash in list context) of the fields
# in column => value format.
#
# Call it as %rec = get_rec(\*FH, $table_name, \%db_def, $delimiter, \@fields);
# You can, if you prefer, also make the delimiter a scalar reference.
# The hash should be the %db_def used in Links 2.x.
sub get_rec {
    defined wantarray or return; # Don't bother doing anything in void context
    my $fh = shift;
    my $table_name = shift;
    my $db_def = shift;
    my $delimiter = ref $_[0] eq 'SCALAR' ? ${shift()} : shift;
    my ($fields,@fields,%fields);
    if (@_) {
        $fields = 1;
        @fields = ref $_[0] eq 'ARRAY' ? @{shift()} : @_;
        %fields = map { ($_ => 1) } @fields;
    }
    defined fileno($fh) or critical "Interal error: File handle passed to get_rec() is not an opened file";

    my @mapping = sort { $db_def->{$a}[0] <=> $db_def->{$b}[0] } keys %$db_def;
    local $/ = "\n";
    my $line;
    until (defined $line) {
        $line = <$fh>;
        return unless defined $line; # Catch the end of the file.
        chomp $line;
        $line ||= undef;
    }
    my $i = 0;
    my @rec = split /\Q$delimiter/, $line, -1;
    my %rec;
    for (@rec) {
        s/``/\n/g;
        s/~~/|/g;
        $_ = undef if $_ eq 'NULL';
    }
    for (0..$#rec) {
        if (defined $mapping[$_] and (!$fields or $fields{$mapping[$_]})) { # Skip "extra" and unwanted records
            $rec{$mapping[$_]} = $rec[$_];
        }
    }
    if ($table_name eq 'Links') {
        $rec{Category} =~ y/_/ / if $rec{Category};
        $rec{Hits} ||= 0 if exists $rec{Hits}; # Fix for Links 2 database having the Hits table removed
    }
    elsif ($table_name eq 'Category') {
        $rec{Name} =~ y/_/ / if $rec{Name};
        $rec{Related} =~ y/_/ / if $rec{Related};
    }

    $fields or return wantarray ? %rec : \%rec;
    my @ret = map $rec{$_}, @fields;
    return wantarray ? @ret : \@ret;
}

# Converts a date. Returns false if the date is invalid.
sub convert_date ($) {
    my $in = shift;
    my ($day, $mon, $year) = split /-/, $in, 3;
    my %months = qw(Jan 01 Feb 02 Mar 03 Apr 04 May 05 Jun 06 Jul 07 Aug 08 Sep 09 Oct 10 Nov 11 Dec 12);
# Any extra fields needed should be set like this:
#    $months{Okt} = "10";
#    $months{Mai} = "05";
#    $months{Dez} = "12";
#
    if ($year and $months{$mon} and $day) {
        return sprintf("%04d-$months{$mon}-%02d", $year, $day);
    } else {
        warning "Invalid date `$in' encountered.";
        return;
    }
}

# Returns a random password of random length (20-25 characters).
sub random_pass () {
    my @chars = ('a'..'z','A'..'Z',0..9,qw a _ [ ] { } ` ' " ! @ ^ * ( ) - _ = + : ; . / \ a,'#',',');
    my $pass = join '', map { $chars[rand @chars] } 0..(20+rand(5));
}

"True or not true? That is the question."