# ================================================================== # Gossamer Links - enhanced directory management system # # Website : http://gossamer-threads.com/ # Support : http://gossamer-threads.com/scripts/support/ # Revision : $Id: L1S2.pm,v 1.25 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::L1S2; 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); # Check to see if this should be a Links SQL 1.x import instead of Links 1.x. my $error_msg = ""; -e "$$opt{source}/links.cfg" or $error_msg .= "$$opt{source}/links.cfg does not exist."; -e "$$opt{source}/Links.def" and $error_msg .= " $$opt{source}/Links.def DOES exist. Perhaps you meant to import Links SQL 1.x instead of Links 1.x?"; critical $error_msg if $error_msg; my $did = do { package Links1::Def::Links; # Avoid namespace pollution do "$$opt{source}/links.cfg"; }; !$did and $! and critical "Cannot open $$opt{source}/links.cfg (This error may result from links.def): $!".($@ ? ", ".substr($@,0,length($@)-1) : ""); !$did and $@ and critical "Cannot parse $$opt{source}/links.cfg (This error may result from links.def): $@"; $Links1::Def::Links::db_file_name or critical "links.cfg did not load correctly. Import aborted."; $did = do { package Links1::Def::Category; local $ENV{PATH_INFO} = "/category"; do "$$opt{source}/links.cfg"; }; !$did and $! and critical "Cannot open $$opt{source}/links.cfg (This error may result from category.def): $!".($@ ? ", ".substr($@,0,length($@)-1) : ""); !$did and $@ and critical "Cannot parse $$opt{source}/links.cfg (This error may result from category.def): $@"; $Links1::Def::Category::db_file_name or critical "links.cfg did not load correctly. Import aborted."; open CATS, "<$Links1::Def::Category::db_file_name" or critical "Unable to open $Links1::Def::Links::db_file_name: $!"; open LINKS, "<$Links1::Def::Links::db_file_name" or critical "Unable to open $Links1::Def::Links::db_file_name: $!"; if (open VALIDATE, "<$Links1::Def::Links::db_valid_name") { $have_validate_db = 1; } else { warning "Could not open $Links1::Def::Links::db_valid_name: $!. Non-validated links will not 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/,'Contact Name','Contact Email'} ); my %i_non_standard_cols; $i_non_standard_cols{Links} = { map { !$i_standard_cols{Links}{$_} ? ($_ => 1) : () } @Links1::Def::Links::db_cols }; $i_non_standard_cols{Category} = { map { !$i_standard_cols{Category}{$_} ? ($_ => 1) : () } @Links1::Def::Category::db_cols }; my $Links_counter; my $Category_counter; if (($DB->table('Links')->{connect}->{driver} || "") eq "ODBC") { $e_dbh->do("SET IDENTITY_INSERT Links ON"); $e_dbh->do("SET IDENTITY_INSERT Category ON"); } 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(); } # 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"); $editor->add_col( $_, { type => 'TEXT', size => $Links1::Def::Category::db_max_field_length, ($Links1::Def::Category::db_not_null{$_} ? (not_null => 1) : ()), ($Links1::Def::Category::db_defaults{$_} ? (default => $Links1::Def::Category::db_defaults{$_}) : ()), ($Links1::Def::Category::db_valid_types{$_} ? (regex => $Links1::Def::Category::db_valid_types{$_}) : ()), } ); $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 = $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 = $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 @cat_relations; my $cat_imported = 0; import_print "\nImporting Categories ...\n"; my @cat_data; while (my $row = get_rec(\*CATS,'Category',\@Links1::Def::Category::db_cols,"|",\@cat_get_cols)) { push @cat_data, $row if ref $row eq 'ARRAY'; } @cat_data = sort { $a->[1] cmp $b->[1] } @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 { if ($$opt{create_missing_categories}) { unless ($missing_cats{$father_full_name}++) { unshift @missing_cats, $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 last; } else { unshift @missing_cats, $fn; mild_warning "$fn is needed for category $full_name and does not exist. It will be created"; } } } 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; } } $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; 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; } } else { 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; } } 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) { my ($name) = m[([^/]*)\Z]; my ($father_full) = m[\A(.*)/]; my $father_id; if ($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 /\|/, $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."; } } } import_print "$cat_rel_imported Category Relations imported.\n"; } # Links { my @links_get_cols = ('ID','Category','Date','Contact Name','Contact Email', qw/Title URL Description Hits isNew isPopular/); my $links_ins_cols = "(ID, LinkOwner, isValidated, Add_Date, Mod_Date, Contact_Name, Contact_Email, Title, URL, Description, Hits, isNew, isPopular"; 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_standard_cols{Links}{$_}, keys %{$i_non_standard_cols{Links}}) { $links_ins_cols .= ", $_"; $links_ins_vals .= ", ?"; push @links_get_cols, $_; } for (grep +(!$e_standard_cols{Links} and !$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"); $editor->add_col( $_, { type => 'TEXT', size => $Links1::Def::Links::db_max_field_length, ($Links1::Def::Links::db_not_null{$_} ? (not_null => 1) : ()), ($Links1::Def::Links::db_defaults{$_} ? (default => $Links1::Def::Links::db_defaults{$_}) : ()), ($Links1::Def::Links::db_valid_types{$_} ? (regex => $Links1::Def::Links::db_valid_types{$_}) : ()), } ) or critical("Unable to add column $_: $GT::SQL::error"); $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 .= ")"; my $user_ins_sth = $e_dbh->prepare("INSERT INTO ${e_prefix}Users (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 = $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 = $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',\@Links1::Def::Links::db_cols,"|",\@links_get_cols)) { $row = [@$row]; # Remove aliasing my ($id, $cat_name, $date, $contact_name, $contact_email) = splice @$row,0,5; 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 $cat_id = $cat_map{$cat_name}; 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 last; } else { unshift @needed, $fn; } } for (@needed) { my ($name) = m[([^/]+)\Z]; unless ($name) { warning "Unable to create category $_ because it is an invalid name. Link ID $id will be skipped as a result."; 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; } 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 { warning("Invalid category `$cat_name' for link $$row[0] (ID: $id, line $.). Link skipped"),next unless defined $cat_id; } } next LINK unless defined $cat_id; 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, $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]; } elsif ($contact_email) { $user_ins_sth->execute(($contact_email) x 2, (defined $contact_name ? $contact_name : ""), 'Yes') 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 '')." (URL: ".($$row[1] or "")."). Setting link owner to `admin'"); $username = 'admin'; } if ($insert_link_sth->execute($id,$username,'Yes',$date,$date,@$row)) { $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',\@Links1::Def::Links::db_cols,"|",\@links_get_cols)) { $row = [@$row]; # Remove aliasing my ($id, $cat_name, $date, $contact_name, $contact_email) = splice @$row,0,5; 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 $cat_id = $cat_map{$cat_name}; 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 last; } else { unshift @needed, $fn; } } for (@needed) { my ($name) = m[([^/]+)\Z]; unless ($name) { warning "Unable to create category $_ because it is an invalid name. Link ID $id will be skipped as a result."; 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; } 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 { warning("Invalid category `$cat_name' for link $$row[0] (ID: $id, line $.). Link skipped"),next unless defined $cat_id; } } next LINK unless defined $cat_id; 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, 'Yes', $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]; } elsif ($contact_email) { $user_ins_sth->execute(($contact_email) x 2, (defined $contact_name ? $contact_name : ""), 'Yes') 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 '')." (URL: ".($$row[1] or "")."). Setting link owner to `admin'"); $username = 'admin'; } if ($insert_link_sth->execute($id,$username,'No',$date,$date,@$row)) { $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_cols, $delimiter, \@fields); # You can, if you prefer, also make the delimiter a scalar reference. # @db_cols should be the @db_cols from Links 1.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_cols = 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"; local $/ = "\n"; my $line; until (defined $line) { $line = <$fh>; return unless defined $line; # Catch the end of the file. chomp $line; $line ||= undef; # skip blanks } 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 $db_cols->[$_] and (!$fields or $fields{$db_cols->[$_]})) { # Skip "extra" and unwanted records $rec{$db_cols->[$_]} = $rec[$_]; } } if ($table_name eq 'Links') { $rec{Category} =~ y/_/ / if $rec{Category}; } 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"; # $day = sprintf "%02d", $day; $year = sprintf "%04d", $year; if ($year and $months{$mon} and $day) { return sprintf("%04d-$months{$mon}-%02d", $year, $day); } else { 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."