#!/usr/bin/perl
use strict;
use warnings;
use DBI;
use Getopt::Long;
use YAML;
use Date::Parse;
my (%conf, $log, $src_dbh, $dest_dbh, $vids, $categories, $blog, $comments, 
    $albums, $photos);
our $VERSION = 0.5;

# Defaults
%conf = (src_host => '127.0.0.1', 
	 src_user => 'jaws',
	 src_dbname => 'jaws',
	 dest_host =>  '127.0.0.1', 
	 dest_user => 'drupal',
	 dest_dbname => 'drupal',
	 level => 3,
	 timezone => 'GMT-5',
	 uid => 1,
	 albums => 0,
	 filepath => 'files/images');

GetOptions (\%conf, 
	    'src_host=s', 'src_user=s', 'src_passwd=s', 'src_dbname=s', 
	    'dest_host=s', 'dest_user=s', 'dest_passwd=s', 'dest_dbname=s',
	    'level=i', 'timezone=s', 'uid=i', 'albums');

$log = Logger->new($conf{level});

confirm_begin() or exit 0;

$src_dbh = db_connect($conf{src_host}, $conf{src_user}, 
		      $conf{src_passwd}, $conf{src_dbname});
$dest_dbh = db_connect($conf{dest_host}, $conf{dest_user}, 
		       $conf{dest_passwd}, $conf{dest_dbname});

$categories = migrate_categories($src_dbh, $dest_dbh);
$blog = migrate_blog($src_dbh, $dest_dbh, $conf{timezone});
$comments = migrate_comments($src_dbh, $dest_dbh, $conf{timezone});
if ($conf{albums}) {
    $albums = migrate_albums($src_dbh, $dest_dbh, $conf{timezone});
    $photos = migrate_photos($src_dbh, $dest_dbh, $conf{timezone});
} else {
    $log->log(3, "Not migrating photo albums ('albums' options not set)");
}

############################################################
# Initialization
sub db_connect {
    my ($host, $user, $passwd, $dbname) = @_;
    my (@dsn, $dbh);
    # Minimal usable DSN
    @dsn = ("dbi:mysql:dbname=$dbname", $user, $passwd);
    $dsn[0] .= ";host=$host" if $host;

    $dbh = DBI->connect(@dsn) or die "Could not connect to $dsn[0]";
    $log->log(5, "Connected to the database $dbname");
    return $dbh;
}

sub confirm_begin {
    my $confirm;
    print qq(
JAWS to Drupal migration - $VERSION

Running this program WILL DESTROY the data in your
'$conf{dest_dbname}' database, which is expected to already contain
the basic Drupal 5.x schema. Probably (if all goes well), this
database will be populated with the data currently present in your
JAWS 0.6/0.7 database '$conf{src_dbname}'.

Are you sure you want to continue? (y/N) );

    $confirm = <STDIN>;
    return $confirm =~ /^y/i;
}

############################################################
# Categories	
sub migrate_categories {
    my ($src, $dest, $categories);
    $src = shift;
    $dest = shift;

    prepare_for_categories($dest);
    for my $categ (get_categories($src)) {
	create_category($dest, $categ);
	$categories->{$categ->orig_id} = $categ;
	$log->log(4, sprintf("Created category %s: %d - %d ", 
			     $categ->name, $categ->orig_id, $categ->new_id));
    }

    return $categories;
}

sub prepare_for_categories {
    my ($dbh, $vid);
    $dbh = shift;

    $log->log(5, 'Clearing categories information');
    for my $table qw(vocabulary term_relation term_synonym term_hierarchy 
		     term_node term_data vocabulary_node_types cache 
		     cache_filter cache_views cache_page) {
	$dbh->do("DELETE FROM $table");
	$dbh->do("ALTER TABLE $table auto_increment = 1");
    }
    $dbh->do("INSERT INTO vocabulary (name, description, help, relations, 
        hierarchy, multiple, required, tags, module, weight) VALUES 
        ('Category', '', 'Category', 1, 2, 1, 1, 0, 'taxonomy', 0)");

    $vids->{category} = get_last_id($dbh);
    upd_sequence($dbh, 'vocabulary_vid', $vids->{category});
    $dbh->do('INSERT INTO vocabulary_node_types (vid, type) VALUES  ' .
	     "($vids->{category}, 'blog')");
}

sub get_categories {
    my ($dbh, $sth, $rv);
    $dbh = shift;
    $sth = $dbh->prepare('SELECT id, name FROM blog_category ORDER BY id');
    $rv = $sth->execute;
    $log->log(3, "Got the $rv registered categories");
    return map {Category->new(@$_)} @{$sth->fetchall_arrayref}
}

sub create_category {
    my ($dbh, $categ, $sth, $new_id);
    $dbh = shift;
    $categ = shift;

    $log->log(4, "Creating category: ".$categ->name);

    $sth = $dbh->prepare('INSERT INTO term_data (vid, name, description, 
        weight) VALUES (?, ?, ?, ?)');
    $sth->execute($vids->{category}, $categ->name, '', 0);

    $new_id = get_last_id($dbh);
    upd_sequence($dbh, 'term_data_tid', $new_id);
    $sth = $dbh->prepare('INSERT INTO term_hierarchy (tid, parent) 
        VALUES (?, ?)');
    $sth->execute($new_id, 0);

    $categ->set_new_id($new_id);

    $log->log(5, "New category ID: $new_id");
}

############################################################
# Blog postings
sub migrate_blog {
    my ($src, $dest, $blog, $tz);
    $src = shift;
    $dest = shift;
    $tz = shift;

    prepare_for_blog($dest);
    for my $posting (get_blog_postings($src, $tz)) {
	create_blog_posting($dest, $posting);
	$blog->{$posting->orig_id} = $posting;
    }

    return $blog;
}

sub prepare_for_blog {
    my ($dbh, $sth, $user);
    $dbh = shift;

    for my $table qw(node_revisions node_counter node_access 
		     node_comment_statistics node url_alias node_access) {
	$dbh->do("DELETE FROM $table");
	$dbh->do("ALTER TABLE $table auto_increment = 1");
    }
    $dbh->do("INSERT INTO node_access (nid, gid, realm, grant_view, 
        grant_update, grant_delete) VALUES (0,0,'all',1,0,0)");

    $sth = $dbh->prepare('SELECT name FROM users WHERE uid = ?');
    $sth->execute($conf{uid});
    ($user) = $sth->fetchrow_array;
    if ($user) {
	$log->log(3, "Creating entries under user $user ($conf{uid})");
    } else {
	$log->log(1, "User $conf{uid} not yet registered - Create it! ".
		  "(Else, nobody will be able to see the contents)");
    }
}

sub get_blog_postings {
    my ($dbh, $tz, $sth, $rv, @blog);
    $dbh = shift;
    $tz = shift;
    # We ignore:
    # - Comments: We'll better use count(comments), as this field sometimes 
    #   lies
    # - Clicks: I get only zeros, so...
    $sth = $dbh->prepare('SELECT id, category_id, title, text, fast_url, 
        createtime, updatetime, allow_comments, published FROM blog 
        ORDER BY id');
    $rv = $sth->execute;
    $log->log(3, "Got the $rv registered blog entries listing");
    @blog = map {BlogEntry->new(@$_, $tz)} @{$sth->fetchall_arrayref};

    $sth = $dbh->prepare('SELECT category_id FROM blog_entrycat WHERE 
        entry_id = ?');
    for my $posting (@blog) {
	$sth->execute($posting->orig_id);
	$posting->set_categories([map {$_->[0]} @{$sth->fetchall_arrayref}]);
    }

    return @blog;
}

sub create_blog_posting {
    my ($dbh, $posting, $sth, $nid);
    $dbh = shift;
    $posting = shift;

    $log->log(4, "Creating blog posting: ".$posting->title);

    $sth = $dbh->prepare('INSERT INTO node (type, title, uid, status, created,
        changed, comment, promote, moderate, sticky) 
        VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?);');
    # Status hardwired to 1 (published)
    # Comment hardwired to 2 (allow read/write)
    $sth->execute('blog', $posting->title, $conf{uid}, 1, $posting->created,
		  $posting->changed, 2, 1, 0, 0);
    $nid = get_last_id($dbh);
    upd_sequence($dbh, 'node_nid', $nid);
    $posting->set_new_id($nid);

    # The fast URL becomes a URL alias.
    # keep 'blog/show' to preserve the old URLs
    $sth = $dbh->prepare('INSERT INTO url_alias (src, dst) VALUES (?, ?)');
    $sth->execute("node/$nid", "blog/show/".$posting->fast_url);

    # vid (Vocabulary ID) seems to be always equal to the node ID, at least in
    # the Drupal systems I have access to (blog-based) it is always the same as
    # nid (Node ID)... so... 
    $sth = $dbh->prepare('UPDATE node SET vid = nid WHERE nid = ?');
    $sth->execute($nid);
    $sth = $dbh->prepare('INSERT INTO node_revisions (nid, vid, uid, title, 
        body, teaser, timestamp, format, log) 
        VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?)');
    $sth->execute($nid, $nid, $conf{uid}, $posting->title, $posting->text, 
		  $posting->text, $posting->changed, 2, '');

    # Categories become terms
    $sth = $dbh->prepare('INSERT INTO term_node (nid, tid) VALUES (?, ?)');
    for my $category (@{$posting->categories}) {
	my $categ = $categories->{$category};
	$sth->execute($posting->new_id, $categ->new_id);
    }

    # Update the sequences to reflect the relevant IDs
    $sth = $dbh->prepare('UPDATE sequences SET id = ? WHERE name = ?');
    $sth->execute($nid, 'node_nid');
    $sth->execute($nid, 'node_revisions_vid');

    return 1;
}

############################################################
# Comments to each blog entry

sub migrate_comments {
    my ($src, $dest, $tz, $comments);
    $src = shift;
    $dest = shift;
    $tz = shift;

    prepare_for_comments($dest);
    for my $comment (get_comments($src, $tz)) {
	$comments->{$comment->orig_id} = $comment;

	if ($comment->parent == 0 or !defined $comments->{$comment->parent}) {
	    $comment->set_pid(0);
	} else {
	    $comment->set_pid($comments->{$comment->parent}->new_id);
	}

	if (exists $blog->{$comment->gadget_reference}) {
	    $comment->set_nid($blog->{$comment->gadget_reference}->new_id);
	} else {
	    $log->log(2, sprintf("Comment %d references a non-existant " .
				 "post (%d) - Skipping!", $comment->orig_id,
				 $comment->gadget_reference));
	    next;
	}

	create_comment($dest, $comment);
    }
    update_comment_statistics($dest, $comments);
    fix_comment_nesting($dest, $comments);

    return $comments;
}

sub prepare_for_comments {
    my ($dbh);
    $dbh = shift;

    $dbh->do('DELETE FROM comments');
    $dbh->do('DELETE FROM node_comment_statistics');
    $dbh->do("ALTER TABLE comments auto_increment = 1");
}

sub get_comments {
    my ($dbh, $tz, $sth, $rv);
    $dbh = shift;
    $tz = shift;

    $sth = $dbh->prepare('SELECT id, parent, gadget_reference, name, email,
        url, ip, title, message, createtime FROM comments WHERE gadget = ?
        ORDER BY id');
    $rv = $sth->execute('Blog');
    $log->log(3, "Got the $rv registered blog comments");
    return map {Comment->new(@$_, $tz)} @{$sth->fetchall_arrayref};
}

sub create_comment {
    my ($dbh, $comment, $sth, $id);
    $dbh = shift;
    $comment = shift;

    $log->log(4, "Creating comment: ".$comment->title);

    $sth = $dbh->prepare('INSERT INTO comments (pid, nid, uid, subject, 
        comment, hostname, timestamp, score, status, format, thread, users, 
        name, mail, homepage) 
        VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?, ?)');

    # Uid: Hardwired to 0 (non-authenticated), as we don't have a way to map
    # them
    # Score: 0
    # Status: 0 (published)
    # Format: 2 (HTML)
    # Thread: 01/ (fixed in fix_comment_nesting later on)
    # Users: a:1:{i:0;i:0;} (don't ask, just copy what Drupal does all over)
    $sth->execute($comment->pid, $comment->nid, 0, $comment->title,
		  $comment->message, $comment->ip, $comment->timestamp,
		  0, 0, 2, '01/', 'a:1:{i:0;i:0;}', $comment->name, 
		  $comment->email, $comment->url);

    $id = get_last_id($dbh);
    upd_sequence($dbh, 'comments_cid', $id);
    $comment->set_new_id($id);
}

sub update_comment_statistics {
    my ($dbh, $comments, $sth, %by_nid);
    $dbh = shift;
    $comments = shift;

    $sth = $dbh->prepare('INSERT INTO node_comment_statistics (nid, 
        last_comment_timestamp, last_comment_name, last_comment_uid, 
        comment_count) VALUES (?, ?, ?, ?, ?)');

    for my $comment (values %$comments) {
	# Skip invalid comments
	next unless $comment->new_id;
	$by_nid{$comment->nid} ||= [];
	push @{ $by_nid{$comment->nid} }, $comment
    }

    # We rearrange %by_nid just to be able to easily query the last comment 
    # in the next block
    for my $comments (values %by_nid) {
	$comments = [sort {$a->new_id <=> $b->new_id} @$comments];
    }

    for my $posting (values %$blog) {
	if (my $msgs = $by_nid{$posting->new_id}) {
	    my $last = $msgs->[$#$msgs];
	    # UID 0? Yes, we don't even try to manage authenticated users
	    $sth->execute($posting->new_id, $last->timestamp, $last->name, 
			  0, scalar(@$msgs));
	} else {
	    # No comments yet for this post
	    $sth->execute($posting->new_id, $posting->created, undef, 0, 0);
	}
    }
}

sub fix_comment_nesting {
    my ($dbh, $comments, %comments, %blog, $by_posting, $sth);
    $dbh = shift;
    $comments = shift;

    # Both $comments and $blog have the JAWS post IDs as its keys - We
    # want to work with Drupal's.  Keep them in %comments and %blog.
    # Oh, and get rid of any possible parentless comments.
    %comments = map {$_->new_id => $_} grep {$_->new_id} values %$comments;
    %blog = map {$_->new_id => $_} values %$blog;

    # $by_posting has as its keys each of the post's NID, and as its values, 
    # hashes with the comments for said post. The comments are in a similar 
    # fashion: Each key is the comment ID, and the value is the comment object.
    # In this function, we will work on the object's "thread" attribute.
    $by_posting = {};
    $sth = $dbh->prepare('UPDATE comments SET thread = ? WHERE cid = ?');

    # To build the threads, remember that no comment should reply to a previous
    # one... So lets just assume it. In the worst case, we will get a broken 
    # thread somewhere along the road... No big deal, IMHO
    for my $comment (map {$comments{$_}} sort {$a<=>$b} keys %comments) {
	my $post = $blog{ $comment->nid }->new_id;
	
	$by_posting->{$post} ||= {};

	if ($comment->pid == 0) {
	    # Comment to the node (top-level)
	    $by_posting->{$post}{ $comment->new_id } = $comment;
	    $comment->set_thread(sprintf '%02d/', 
				 scalar(grep { $by_posting->{$post}{$_}->pid == 0 } 
					keys %{$by_posting->{$post}}));
	} else {
	    # Reply to another comment
	    my ($par_thr, $others);
	    # What is our parent's full thread?
	    $par_thr = $comments{ $comment->pid }->thread;
	    # How many sibling comments do we have?
	    $others = scalar grep {$_->pid == $comment->pid} values %comments;
	    
	    $par_thr =~ s!/$!!;
	    $comment->set_thread(sprintf('%s.%02d/', $par_thr, $others));
	}

	$sth->execute($comment->thread, $comment->new_id);
    }
}

############################################################
# Photo albums
sub migrate_albums {
    my ($src, $dest, $tz, $root, $albums);
    $src = shift;
    $dest = shift;
    $tz = shift;

    $root = prepare_for_albums($dest);
    for my $album (get_albums($src, $tz)) {
	create_album($dest, $album, $root->tid);
	$albums->{$album->orig_id} = $album;
    }

    return $albums;
}

sub prepare_for_albums {
    my ($dbh, $album, $sth);
    $dbh = shift;

    $album = Album->new(0, 'Acidfree albums', 'Acidfree root album', '', '');

    $log->log(5, 'Clearing albums information');
    # term_relation and term_data are cleared in prepare_for_categories
    $dbh->do('DELETE FROM acidfree_album');
    $dbh->do("ALTER TABLE acidfree_album auto_increment = 1");

    $dbh->do("INSERT INTO vocabulary (name, description, help, relations,".
	     "hierarchy, multiple, required, tags, module, weight) VALUES ".
	     "('Acidfree albums', 'This is an Acidfree vocabulary.  Please ".
	     "use the exposed Acidfree interfaces to modify values rather ".
	     "than directly editing vocabs and terms via the taxonomy ".
	     "interface.', '', 1, 2, 1, 1, 0, 'taxonomy', 0)");
    $vids->{acid} = get_last_id($dbh);
    upd_sequence($dbh, 'vocabulary_vid', $vids->{acid});

    # Relate the 'image' and 'video' node types to Acid
    $sth = $dbh->prepare('INSERT INTO vocabulary_node_types (vid, type) ' .
			 'VALUES (?, ?)');
    $sth->execute($vids->{acid}, 'image');
    $sth->execute($vids->{acid}, 'video');

    # Update the 'acidfree_vocab_id' variable
    $dbh->do("DELETE FROM variable WHERE name='acidfree_vocab_id'");
    $dbh->do("INSERT INTO variable (name,value) VALUES ('acidfree_vocab_id', " .
	     "'i:$vids->{acid};')");

    create_album($dbh, $album, 0);
    $log->log(3, "Created root album - " . $album->nid);

    return $album;
}

sub get_albums {
    my ($dbh, $tz, $sth, $rv);
    $dbh = shift;
    $tz = shift;

    $sth = $dbh->prepare('SELECT id, name, description, published, createtime'.
			 ' FROM phoo_album ORDER BY id');
    $rv = $sth->execute;
    $log->log(3, "Got the $rv registered albums");
    return map {Album->new(@$_, $tz)} @{$sth->fetchall_arrayref};
}

sub create_album {
    my ($dbh, $album, $root_tid, $sth, $id);
    $dbh = shift;
    $album = shift;
    $root_tid = shift || 0;

    $log->log(4,sprintf('Creating album: %s (Rooted at %d)', $album->title, 
			$root_tid));

    $dbh->prepare('INSERT INTO term_data (vid, name, description, weight) ' .
		  'VALUES (?, ?, ?, ?)')->execute($vids->{acid}, $album->title,
						  $album->description, 0);

    $id = get_last_id($dbh);
    upd_sequence($dbh, 'term_data_tid', $id);
    # We create just a flat album hierarchy - Everything comes off the root
    # node (defined at prepare_for_albums)
    $dbh->prepare('INSERT INTO term_hierarchy (tid, parent) '.
		  'VALUES (?, ?)')->execute($id, $root_tid);
    $album->set_tid($id);

    # Create album's node/revision
    $dbh->prepare('INSERT INTO node (type, title, uid, status, ' .
		  'created, changed, comment, promote, moderate, ' .
		  'sticky) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)')->
		  execute('acidfree', $album->title, $conf{uid}, 1, 
			  $album->created, $album->created, 2, 0, 0, 1);
    $album->set_nid(get_last_id($dbh));
    $dbh->prepare("UPDATE node SET vid = nid WHERE nid = ?")->
	execute($album->nid);

    $dbh->prepare('INSERT INTO node_revisions (nid, vid, uid, title, '.
		  'body, teaser, timestamp, format, log) VALUES '.
		  '(?, ?, ?, ?, ?, ?, ?, ?, ?)')->
		  execute($album->nid, $album->nid, $conf{uid}, $album->title,
			  $album->description, $album->description, 
			  $album->created, 2, '');
    upd_sequence($dbh, 'node_nid', $album->nid);
    upd_sequence($dbh, 'node_revisions_vid', $album->nid);

    $dbh->prepare('INSERT INTO term_node (tid, nid) VALUES (?, ?)')->
	execute($root_tid, $album->nid);

    # The album itself
    $dbh->prepare('INSERT INTO acidfree_album (aid, tid, thumb, ' .
		  'share, order_by, view) VALUES (?, ?, ?, ?, ?, ?)')->
		  execute($album->nid, $album->tid, '', 0, '<default>', 
			  'grid');
    $album->set_aid(get_last_id($dbh));

    return $album;
}

############################################################
# Photos in each album
#
# How should the files be migrated?
# Phoo stores the full images in the data/phoo/<upload_date>/ directory, and
# the thumbnails and medium-sized resizes respectively in the thumb and medium
# subdirectories.
# Acidfree puts everything in the files/images/ directory, adding the .thumb and
# .preview suffixes to the filename. So, something +- like this should copy the
# files from one hierarchy to the other:
#
# $ cd DRUPAL_BASE/files/images
# $ for i in $(cd JAWS_BASE/html/data/phoo; ls */*{jpg,JPG,jpeg,gif,png}); do j=$(echo $i|perl -pe 's!/([^/]+)$!_$1!'); cp JAWS_BASE/html/data/phoo/$i $j; done 
# $ for i in $(cd JAWS_BASE/html/data/phoo; ls */medium/*{jpg,JPG,jpeg,gif,png}); do j=$(echo $i|perl -pe 's!/medium/([^/]+)$!_$1!; s!\.([^\.]+)$!.preview.$1!'); cp JAWS_BASE/html/data/phoo/$i $j; done
# $ for i in $(cd JAWS_BASE/html/data/phoo; ls */thumb/*{jpg,JPG,jpeg,gif,png}); do j=$(echo $i|perl -pe 's!/thumb/([^/]+)$!_$1!; s!\.([^\.]+)$!.thumb.$1!'); cp JAWS_BASE/html/data/phoo/$i $j; done

sub migrate_photos {
    my ($src, $dest, $tz, $photos);
    $src = shift;
    $dest = shift;
    $tz = shift;

    prepare_for_photos($dest);
    for my $photo (get_photos($src, $tz)) {
	create_photo($dest, $photo);
	$photos->{$photo->orig_id} = $photo
    }

    return $photos;
}

sub prepare_for_photos {
    my ($dbh);
    $dbh = shift;

    $dbh->do('DELETE FROM files');
    $dbh->do('ALTER TABLE files auto_increment=1');
    $dbh->do('DELETE FROM file_revisions');
    $dbh->do('ALTER TABLE file_revisions auto_increment=1');
    upd_sequence($dbh, 'files_fid', 1);
}

sub get_photos {
    my ($dbh, $tz, $sth, $rv, $sth2, @photos);
    $dbh = shift;
    $tz = shift;

    $sth = $dbh->prepare('SELECT id, filename, title, description, '.
			 'createtime, updatetime FROM phoo_image ORDER BY id');
    $sth2 = $dbh->prepare('SELECT phoo_album_id FROM phoo_image_album WHERE ' .
			  'phoo_image_id = ?');

    $rv = $sth->execute;
    $log->log(3, "Got $rv registered photos");

    while (my $photo = $sth->fetchrow_arrayref) {
	$sth2->execute($photo->[0]);
	my $albums = [map { $albums->{$_->[0]} } @{$sth2->fetchall_arrayref}];
	push @photos, Photo->new(@$photo, $albums, $tz);
    }

    return @photos;
}

sub create_photo {
    my ($dbh, $photo, $sth, $sth2);
    $dbh = shift;
    $photo = shift;

    $dbh->prepare('INSERT INTO node (type, title, uid, status, ' .
		  'created, changed, comment, promote, moderate, ' .
		  'sticky) VALUES (?, ?, ?, ?, ?, ?, ?, ?, ?, ?)')->
		  execute('image', $photo->title, $conf{uid}, 1,
			  $photo->created, $photo->created, 2, 0, 0, 1);
    $photo->set_new_id(get_last_id($dbh));
    $dbh->prepare("UPDATE node SET vid = nid WHERE nid = ?")->
	execute($photo->new_id);

    $dbh->prepare('INSERT INTO node_revisions (nid, vid, uid, title, '.
		  'body, teaser, timestamp, format, log) VALUES '.
		  '(?, ?, ?, ?, ?, ?, ?, ?, ?)')->
		  execute($photo->new_id, $photo->new_id, $conf{uid}, 
			  $photo->title, $photo->description, 
			  $photo->description, $photo->created, 2, '');
    upd_sequence($dbh, 'node_nid', $photo->new_id);
    upd_sequence($dbh, 'node_revisions_vid', $photo->new_id);

    $sth = $dbh->prepare('INSERT INTO term_node (nid, tid) VALUES (?, ?)');
    for my $album (@{$photo->albums}) {
	$sth->execute($photo->new_id, $album->tid);
    }

    $sth = $dbh->prepare('INSERT INTO files (fid, nid, filename, filepath, ' .
			 'filemime, filesize) VALUES (?, ?, ?, ?, ?, ?)');
    $sth2 = $dbh->prepare('INSERT INTO file_revisions (fid, vid, ' .
			  'description, list) VALUES (?, ?, ?, ?)');
    for my $type (['_original', 'base_filename'], 
		  ['thumbnail', 'thumb'],
		  ['preview', 'preview']) {
	my ($filepath, @filestat, $filesize, $fid);
	$filepath = $conf{filepath} . '/' . eval('$photo->'.$type->[1]);
	@filestat = stat($filepath);
	$filesize = $filestat[7] || 0;

	# For some reason, Files does not have FID as an auto-increment field :-/
	$fid = get_next_fid($dbh);
	$sth->execute($fid, $photo->new_id, $type->[0], $filepath,
		      $photo->mime, $filesize);
	$sth2->execute($fid, $photo->new_id, '', 0);
    }
}


###########################################################################
# Utility functions...
sub get_last_id {
    my ($dbh, $sth, $res);
    $dbh = shift;
    $sth = $dbh->prepare('SELECT last_insert_id()');
    $sth->execute;
    ($res) = $sth->fetchrow_array;
    return $res;
}

sub upd_sequence {
    my ($dbh, $table, $id, $sth, $rv);
    $dbh = shift;
    $table = shift;
    $id = shift;

    $sth = $dbh->prepare('UPDATE sequences SET id = ?  WHERE name = ?');
    $rv = $sth->execute($id, $table);
    warn "Could not update sequence $table to $id!" if (!$rv or $rv == 0);
}

sub get_next_fid {
    my ($dbh, $sth, $id);
    $dbh = shift;
    $sth = $dbh->prepare('SELECT id FROM sequences WHERE name = ?');
    $sth->execute('files_fid');
    ($id) = $sth->fetchrow_array;

    $sth = $dbh->prepare('UPDATE sequences SET id = ? WHERE name = ?');
    $sth->execute(++$id, 'files_fid');

    return $id;
}

###########################################################################
# Logger: Report progress to the user

package Logger;
sub new {
    my ($class, $level);
    $class = shift;
    $level = shift;
    return bless {level => $level}, $class
}

sub log {
    my ($self, $level, $msg);
    $self = shift;
    $level = shift;
    $msg = join '', @_;
    return undef if $level > $self->{level};
    print "$msg\n";
}

package AutoAccessor;
our ($AUTOLOAD);
use Carp;

sub DESTROY {}
sub AUTOLOAD {
    # We AUTOLOAD the attribute accessors
    my ($self, $class, $attribute);
    $self = shift;
    $class = ref($self);

    # $AUTOLOAD brings in the class name - Strip it off!
    $attribute = $AUTOLOAD;
    substr($attribute,0,length($class)+2,'');

    croak sprintf('Tried to access invalid attribute for %s: %s',
		  $class, $attribute) 
	unless exists $self->{$attribute};

    return $self->{$attribute};
}


###########################################################################
# Category: Map the old categories to the new ones
package Category;
use base 'AutoAccessor';

sub new {
    my ($class, $id, $name);
    $class = shift;
    $id = shift;
    $name = shift;
    return bless {orig_id => $id, name => $name}, $class;
}

sub set_new_id { $_[0]{new_id} = $_[1] }

###########################################################################
# BlogEntry: Each of the blog entries
package BlogEntry;
use Date::Parse;
use base 'AutoAccessor';

sub new {
    # Yes, this is too strict. But as this is not a general-purpose class, as
    # it is meant only to serve this very script... We'll hardwire...
    my ($class, @data);
    $class = shift;
    @data = @_;
    return bless {orig_id => $data[0], category_id => $data[1], 
		  title => $data[2], text => $data[3], fast_url => $data[4],
		  createtime => $data[5], updatetime => $data[6], 
		  allow_comments => $data[7], published => $data[8],
		  timezone => $data[9]}, $class;

}

sub set_new_id { $_[0]{new_id} = $_[1] }
sub set_categories { $_[0]{categories} = $_[1] }

sub created { 
    my $self = shift;
    return str2time($self->createtime . ' ' . $self->timezone);
}
sub changed {
    my $self = shift;
    return str2time($self->updatetime . ' ' . $self->timezone);
}

###########################################################################
# Comment: Each of the comments
package Comment;
use Date::Parse;
use base 'AutoAccessor';

sub new {
    # Yes: Look at BlogEntry's opening comment about the hard-wiredness.
    my ($class, @data);
    $class = shift;
    @data = @_;
    return bless {orig_id => $data[0], parent => $data[1], 
		  gadget_reference => $data[2], name => $data[3],
		  email => $data[4], url => $data[5], ip => $data[6],
		  title => $data[7], message => $data[8],
		  createtime => $data[9], timezone => $data[10],
		  new_id => undef, pid => undef, nid => undef,
		  thread => undef}, $class;
}

sub set_new_id { $_[0]{new_id} = $_[1] }
sub set_pid { $_[0]{pid} = $_[1] }
sub set_nid { $_[0]{nid} = $_[1] }
sub set_thread { $_[0]{thread} = $_[1] }

sub timestamp {
    my $self = shift;
    return str2time($self->createtime . ' ' . $self->timezone);
}
###########################################################################
# Album: Photo albums
package Album;
use Date::Parse;
use base 'AutoAccessor';

sub new {
    my ($class, @data);
    $class = shift;
    @data = @_;
    return bless {orig_id => $data[0], title => $data[1], 
		  description => $data[2], createtime => $data[3],
		  timezone => $data[4]}, $class;
}

sub set_nid { $_[0]{nid} = $_[1] }

sub set_tid { $_[0]{tid} = $_[1] }

sub set_aid { $_[0]{aid} = $_[1] }

sub created {
    my ($self, $res);
    $self = shift;
    $res = str2time($self->createtime . ' ' . $self->timezone);
    $res ||= time;
    return $res;
}

###########################################################################
# Photo
package Photo;
use Date::Parse;
use base 'AutoAccessor';

sub new {
    my ($class, @data);
    $class = shift;
    @data = @_;
    # We don't want null descriptions!
    $data[3] ||= '';
    return bless {orig_id => $data[0], filename => $data[1], title => $data[2],
		  description => $data[3], createtime => $data[4], 
		  updatetime => $data[5], albums => $data[6], 
		  timezone => $data[7]}, $class;
}

sub set_new_id { $_[0]{new_id} = $_[1] }

sub base_filename {
    my ($self, $orig);
    $self = shift;
    return $self->{base_filename} if defined $self->{base_filename};
    $orig = $self->filename;

    $orig =~ s!^(?:data.)?phoo/!!;
    $orig =~ s!/!_!;
    $self->{base_filename} = $orig;

    return $self->{base_filename};
}

sub thumb {
    my ($self, $name);
    $self = shift;
    return $self->{thumb} if defined $self->{thumb};
    $name = $self->base_filename;
    $name =~ s!\.([^\.]+)$!.thumb.$1!;
    $self->{thumb} = $name;

    return $self->{thumb};
}

sub preview {
    my ($self, $name);
    $self = shift;
    return $self->{preview} if defined $self->{preview};
    $name = $self->base_filename;
    $name =~ s!\.([^\.]+)$!.preview.$1!;
    $self->{preview} = $name;

    return $self->{preview};
}

sub created {
    my $self = shift;
    return str2time($self->createtime . ' ' . $self->timezone);
}

sub mime {
    my $self = shift;
    return 'image/jpeg' if $self->filename =~ /jpg$/i;
    return 'image/png' if $self->filename =~ /png$/i;
    return 'image/gif' if $self->filename =~ /gif$/i;
    return 'application/octet-stream';
}

sub changed {
    my $self = shift;
    return str2time($self->updatetime . ' ' . $self->timezone); 
}