root/branches/release-41/lib/MT/BackupRestore.pm @ 2730

# Movable Type (r) Open Source (C) 2001-2008 Six Apart, Ltd.
# This program is distributed under the terms of the
# GNU General Public License, version 2.
#
# $Id$

package MT::BackupRestore;
use strict;

use MT::Util qw( encode_url );
use Symbol;
use base qw( MT::ErrorHandler );

sub NS_MOVABLETYPE { 'http://www.sixapart.com/ns/movabletype' };

use File::Spec;
use File::Copy;

MT->add_callback('restore', 3, MT->instance, sub {
    my ($cb, $objects, $deferred, $errors, $callback) = @_;
    MT::BackupRestore->cb_restore_objects( $objects, $callback );
});

MT->add_callback('restore_asset', 3, MT->instance, sub {
    my ($cb, $asset, $callback) = @_;
    MT::BackupRestore->cb_restore_asset( $asset, $callback );
});

sub core_backup_instructions {
    # The list of classes that require specific orders
    # and/or special instructions.
    # Every other class will have the order of '500'.
    return {
        'blog'          => {
            'order' => 400
        },
        'author'        => {
            'order' => 420
        },
        # These 'association' classes should be backed up
        # after the object classes.
        'association'   => {
            'order' => 510
        },
        'placement'     => {
            'order' => 510
        },
        'trackback'     => {
            'order' => 510
        },
        'objecttag'     => {
            'order' => 510
        },
        'objectscore'   => {
            'order' => 510
        },
        'objectasset'   => {
            'order' => 510
        },
        # Ping should be backed up after Trackback.
        'tbping'        => {
            'order' => 520
        },
        'ping'          =>  {
            'order' => 520
        },
        'ping_cat'      => {
            'order' => 520
        },
        # Comment should be backed up after TBPing
        # because saving a comment ultimately triggers
        # MT::TBPing::save.
        'comment'        => {
            'order' => 530
        },
        # Session, config and TheSchwartz packages are never backed up.
        'session'       => {
            'skip' => 1
        },
        'config'        => {
            'skip' => 1
        },
        'ts_job'        => {
            'skip' => 1
        },
        'ts_error'      => {
            'skip' => 1
        },
        'ts_exitstatus' => {
            'skip' => 1
        },
        'ts_funcmap'    => {
            'skip' => 1
        },
    };
}

sub _populate_obj_to_backup {
    my $pkg = shift;
    my ($blog_ids) = @_;

    my %populated;
    if ( defined($blog_ids) && scalar(@$blog_ids) ) {
        # author will be handled at last
        $populated{MT->model('author')} = 1;
    }

    my @object_hashes;
    my $types = MT->registry('object_types');
    my $instructions = MT->registry('backup_instructions');
    foreach my $key (keys %$types) {
        next if $key =~ /\w+\.\w+/; # skip subclasses
        my $class = MT->model($key);
        next unless $class;
        next if $class eq $key; # FIXME: to remove plugin object_classes
        next if exists($instructions->{$key})
             && exists($instructions->{$key}{skip})
             && $instructions->{$key}{skip};
        next if exists $populated{$class};
        my $order = exists($instructions->{$key})
                 && exists($instructions->{$key}{order})
            ? $instructions->{$key}{order}
            : 500;
        $pkg->_create_obj_to_backup(
            $class, $blog_ids, \@object_hashes, \%populated, $order);
    }

    if ( defined($blog_ids) && scalar(@$blog_ids) ) {
        # Author has two ways to be associated to a blog
        my $class = MT->model('author');
        unshift @object_hashes, {
            $class => { 
                terms => undef,  
                args => { 'join' =>  
                    [ MT->model('association'), 'author_id', { blog_id => $blog_ids }, { unique => 1 } ] 
                }
            },
            'order' => 500
        }; 
        unshift @object_hashes, {
            $class => { 
                terms => undef,  
                args => { 'join' =>  
                    [ MT->model('permission'), 'author_id', { blog_id => $blog_ids }, { unique => 1 } ] 
                }
            },
            'order' => 500
        };
    }
    @object_hashes = sort { $a->{order} <=> $b->{order} } @object_hashes;
    my @obj_to_backup;
    foreach my $hash ( @object_hashes ) {
        delete $hash->{order};
        push @obj_to_backup, $hash;
    }
    return \@obj_to_backup;
}

sub _create_obj_to_backup {
    my $pkg = shift;
    my ($class, $blog_ids, $obj_to_backup, $populated, $order) = @_;

    my $instructions = MT->registry('backup_instructions');
    my $columns = $class->column_names;
    foreach my $column (@$columns) {
        if ( $column =~ /^(\w+)_id$/ ) {
            my $parent = $1;
            my $p_class = MT->model($parent);
            next unless $p_class;
            next if exists $populated->{$p_class};
            next if exists($instructions->{$parent})
                 && exists($instructions->{$parent}{skip})
                 && $instructions->{$parent}{skip};
            my $p_order = exists($instructions->{$parent})
                       && exists($instructions->{$parent}{order})
                ? $instructions->{$parent}{order}
                : 500;
            $pkg->_create_obj_to_backup(
                $p_class, $blog_ids, $obj_to_backup, $populated, $p_order);
        }
    }
    
    if ( $class->can('backup_terms_args') ) {
        push @$obj_to_backup, {
            $class  => $class->backup_terms_args($blog_ids),
            'order' => $order
        };
    }
    else {
        push @$obj_to_backup, $pkg->_default_terms_args($class, $blog_ids, $order);
    }

    $populated->{$class} = 1;
}

sub _default_terms_args {
    my $pkg = shift;
    my ($class, $blog_ids, $order) = @_;

    if (defined($blog_ids) && scalar(@$blog_ids)) {
        return {
            $class => {
                terms => { 'blog_id' => $blog_ids }, 
                args => undef
            },
            'order' => $order,
        };
    }
    else {
        return {
            $class  => { terms => undef, args => undef },
            'order' => $order,
        };
    }
}
    

sub backup {
    my $class = shift;
    my ($blog_ids, $printer, $splitter, $finisher, $progress, $size, $enc, $metadata) = @_;
    push @$blog_ids, '0'
        if defined($blog_ids) && scalar(@$blog_ids);
    my $obj_to_backup = $class->_populate_obj_to_backup( $blog_ids );

    my $header .= "<movabletype xmlns='" . NS_MOVABLETYPE . "'\n";
    $header .= join ' ', map { $_ . "='" . $metadata->{$_} . "'" } keys %$metadata;
    $header .= ">\n";
    $header = "<?xml version='1.0' encoding='$enc'?>\n$header" if $enc !~ m/utf-?8/i;
    $printer->($header);

    my $files = {};
    _loop_through_objects(
        $printer, $splitter, $finisher, $progress, $size, $obj_to_backup, $files);

    my $else_xml = MT->run_callbacks('Backup', $blog_ids, $progress);
    $printer->($else_xml) if $else_xml ne '1';

    $printer->('</movabletype>');
    $finisher->($files);
}

sub _loop_through_objects {
    my ($printer, $splitter, $finisher, $progress, $size, $obj_to_backup, $files) = @_;

    my $counter = 1;
    my $bytes = 0;
    my %authors_seen;
    my $author_pkg = MT->model('author');
    for my $class_hash (@$obj_to_backup) {
        my ($class, $term_arg) = each(%$class_hash);
        eval "require $class;";
        my $children = $class->properties->{child_classes} || {};
        for my $child_class (keys %$children) {
            eval "require $child_class;";
        }
        if (my $err = $@) {
            $progress->("$err\n", 'Error');
            next;
        }
        my @metacolumns;
        if ( exists( $class->properties->{meta} )
          && $class->properties->{meta} ) {
            require MT::Meta;
            @metacolumns = MT::Meta->metadata_by_class( $class );
        }
        my $records = 0;
        my $state = MT->translate('Backing up [_1] records:', $class);
        $progress->($state, $class->class_type || $class->datasource);
        my $limit = 50;
        my $offset = 0;
        my $terms = $term_arg->{terms} || {};
        my $args = $term_arg->{args};
        unless ( exists $args->{sort} ) {
            $args->{sort} = 'id';
            $args->{direction} = 'ascend';
        }
        while (1) {
            $args->{offset} = $offset;
            $args->{limit} = $limit + 1;
            my $iter;
            eval {
                $iter = $class->load_iter($terms, $args);
            };
            if (my $err = $@) {
                $progress->("$class:$err\n", 'Error');
            }
            last unless $iter;
            my $count = 0;
            my $next  = 0;
            while ( my $object = $iter->() ) {
                if ( $count == $limit ) {
                    $iter->end;
                    $next = 1;
                    $offset += $count;
                    last;
                }
                $count++;
                if ( ( $class eq $author_pkg )
                  && ( exists $authors_seen{$object->id} ) ) {
                    next;
                }
                $bytes += $printer->($object->to_xml(undef, \@metacolumns) . "\n");
                $records++;
                if ($size && ($bytes >= $size)) {
                    $splitter->(++$counter);
                    $bytes = 0;
                }
                if ( $class eq $author_pkg ) {
                    # Authors may be duplicated because of how terms and args are created.
                    $authors_seen{$object->id} = 1;
                } elsif ( $class->datasource eq 'asset' ) {
                    $files->{$object->id} = [$object->url, $object->file_path, $object->file_name];
                }
            }
            last unless $next;
            $progress->($state . " " . MT->translate("[_1] records backed up...", $records), $class->datasource)
                if $records && ($records % 100 == 0);
        }
        if ( $class eq $author_pkg && %authors_seen ) {
            my $num_authors = scalar(keys %authors_seen);
            $progress->($state . " " . MT->translate("[_1] records backed up.", $num_authors), $class->class_type || $class->datasource);
        } elsif ($records) {
            $progress->($state . " " . MT->translate("[_1] records backed up.", $records), $class->class_type || $class->datasource);
        } else {
            $progress->($state . " " . MT->translate("There were no [_1] records to be backed up.", $class), $class->class_type || $class->datasource);
        }
    }
}

sub restore_file {
    my $class = shift;
    my ($fh, $errormsg, $schema_version, $overwrite, $callback) = @_;

    my $objects = {};
    my $deferred = {};
    my $errors = [];

    my ($blog_ids, $asset_ids) = eval { $class->restore_process_single_file(
        $fh, $objects, $deferred, $errors, $schema_version, $overwrite, $callback
    ); };

    unless ( $@ ) {
        MT->run_callbacks('restore', $objects, $deferred, $errors, $callback);
    }
    $$errormsg = join('; ', @$errors);
    ($deferred, $blog_ids);
}
 
sub restore_process_single_file {
    my $class = shift;
    my ($fh, $objects, $deferred, $errors, $schema_version, $overwrite,  $callback) = @_;
    
    my %restored_blogs = map { $objects->{$_}->id => 1; } grep { 'blog' eq $objects->{$_}->datasource } keys %$objects;

    require XML::SAX;
    require MT::BackupRestore::BackupFileHandler;
    my $handler = MT::BackupRestore::BackupFileHandler->new(
        callback => $callback,
        objects => $objects,
        deferred => $deferred,
        errors => $errors,
        schema_version => $schema_version,
        overwrite_template => $overwrite,
    );

    require MT::Util;
    my $parser = MT::Util::sax_parser();
    $callback->(ref($parser) . "\n") if MT->config->DebugMode;
    $parser->{Handler} = $handler;
    eval { $parser->parse_file($fh); };
    if (my $e = $@) {
        push @$errors, $e;
        $callback->($e);
        die $e if $handler->{critical}; 
    }

    my @blog_ids;
    my @asset_ids;

    while (my ($key, $value) = each %$objects) {
        if ('blog' eq $value->datasource) {
            push @blog_ids, $value->id unless exists $restored_blogs{$value->id};
        } elsif ('asset' eq $value->datasource) {
            my ($old_id) = $key =~ /^.+#(\d+)$/;
            push @asset_ids, $value->id, $old_id;
        }
    }
    my $blog_ids = scalar(@blog_ids) ? \@blog_ids : undef;
    my $asset_ids = scalar(@asset_ids) ? \@asset_ids : undef;
    ($blog_ids, $asset_ids);
}

sub restore_directory {
    my $class = shift;
    my ($dir, $errors, $error_assets, $schema_version, $overwrite, $callback) = @_;

    my $manifest;
    my @files;
    opendir my $dh, $dir or push(@$errors, MT->translate("Can't open directory '[_1]': [_2]", $dir, "$!")), return undef;
    for my $f (readdir $dh) {
        next if $f !~ /^.+\.manifest$/i;
        $manifest = File::Spec->catfile($dir, $f);
        last;
    }
    closedir $dh;
    unless ($manifest) {
        push @$errors, MT->translate("No manifest file could be found in your import directory [_1].", $dir);
        return (undef, undef);
    }

    my $fh = gensym;
    open $fh, "<$manifest" or push(@$errors, MT->translate("Can't open [_1].", $manifest)), return 0;
    my $backups = __PACKAGE__->process_manifest($fh);
    close $fh;
    unless($backups) {
        push @$errors, MT->translate("Manifest file [_1] was not a valid Movable Type backup manifest file.", $manifest);
        return (undef, undef);
    }

    $callback->(MT->translate("Manifest file: [_1]", $manifest) . "\n");

    my %objects;
    my $deferred = {};

    my $files = $backups->{files};
    my @blog_ids;
    my @asset_ids;
    for my $file (@$files) {
        my $fh = gensym;
        my $filepath = File::Spec->catfile($dir, $file);
        open $fh, "<$filepath" or push @$errors, MT->translate("Can't open [_1]."), next;

        my ($tmp_blog_ids, $tmp_asset_ids) = eval { __PACKAGE__->restore_process_single_file(
            $fh, \%objects, $deferred, $errors, $schema_version, $overwrite, $callback); };

        close $fh;
        last if $@;

        push @blog_ids, @$tmp_blog_ids if defined $tmp_blog_ids;
        push @asset_ids, @$tmp_asset_ids if defined $tmp_asset_ids;
    }

    unless ( $@ ) {
        MT->run_callbacks('restore', \%objects, $deferred, $errors, $callback);
    }
    my $blog_ids = scalar(@blog_ids) ? \@blog_ids : undef;
    my $asset_ids = scalar(@asset_ids) ? \@asset_ids : undef;
    ($deferred, $blog_ids, $asset_ids);
}

sub process_manifest {
    my $class = shift;
    my ($stream) = @_;

    if ((ref($stream) eq 'Fh') || (ref($stream) eq 'GLOB')){
        seek($stream, 0, 0) or return undef;
        require XML::SAX;
        require MT::BackupRestore::ManifestFileHandler;
        my $handler = MT::BackupRestore::ManifestFileHandler->new();

        require MT::Util;
        my $parser = MT::Util::sax_parser();
        $parser->{Handler} = $handler;
        eval { $parser->parse_file($stream); };
        if (my $e = $@) {
            die $e;
        }
        return $handler->{backups};
    }
    return undef;
}

sub restore_asset {
    my $class = shift;
    my ($file, $asset, $old_id, $fmgr, $errors, $callback) = @_;

    my $id = $asset->id;

    my $path = $asset->file_path;
    unless (defined($path)) {
        $callback->(MT->translate('Path was not found for the file ([_1]).', $id));
        return 0;
    }
    my ($vol, $dir, $fn) = File::Spec->splitpath($path);
    my $voldir =  "$vol$dir";
    if (!-w $voldir) {
        unless (defined $fmgr) {
            my $blog = MT->model('blog')->load($asset->blog_id);
            $fmgr = $blog->file_mgr if $blog;
        }
        unless (defined $fmgr) {
            # we do need utf8_off here
            $errors->{$id} = MT->translate('[_1] is not writable.', MT::I18N::utf8_off($voldir)) ;
        } else {
            $voldir =~ s|/$|| unless $voldir eq '/';  ## OS X doesn't like / at the end in mkdir().
            unless ($fmgr->exists($voldir)) {
                $fmgr->mkpath($voldir) or
                    $errors->{$id} = MT->translate("Error making path '[_1]': [_2]", $path, $fmgr->errstr);
            }
        }
    }
    if (-w $voldir) {
        my $filename = "$old_id-" . $asset->file_name;
        $callback->(MT->translate("Copying [_1] to [_2]...", $filename, $path));
        copy($file, $path)
            or $errors->{$id} = $!;
    }

    if ( exists $errors->{$id} ) {
        return $callback->( MT->translate('Failed: ') . $errors->{$id} . "\n" );
    }

    $callback->( MT->translate("Done.") . "\n" );

    MT->run_callbacks('restore_asset', $asset, $callback);
    
    1;
}

sub _sync_asset_id {
    my ($text, $related) = @_;

    my $new_text = $text;

    $new_text =~ s!<form([^>]*?\s)mt:asset-id=(["'])(\d+)(["'])([^>]*?)>(.+?)</form>!
        my $old_id = $3;
        my $result = '';
        if ( my $asset = $related->{$old_id} ) {
            $result = '<form' . $1 . 'mt:asset-id=' . $2 . $asset->id . $4 . $5 . '>';
            my $html = $6;
            my $filename = quotemeta(encode_url($asset->file_name));
            my $url = $asset->url;
            my @children = MT->model('asset')->load(
                { parent => $asset->id, blog_id => $asset->blog_id, class => '*' }
            );
            my %children = map {
                $_->id => {
                    'filename' => quotemeta(encode_url($_->file_name)),
                    'url' => $_->url
                }
            } @children;
            $result .= $html . '</form>';
        }
        $result;
    !igem;
    return $new_text ? $new_text : $text;
}

sub cb_restore_objects {
    my $pkg = shift;
    my ($all_objects, $callback) = @_;

    my %entries;
    my %assets;
    my %old_ids;
    for my $key ( keys %$all_objects ) {
        if ( $key =~ /^MT::Entry#(\d+)$/ ) {
            my $new_id = $all_objects->{$key}->id;
            $entries{$new_id} = $all_objects->{$key};
        } elsif ( $key =~ /^MT::Asset#(\d+)$/ ) {
            my $old_id = $1;
            my $new_id = $all_objects->{$key}->id;
            $assets{$new_id} = {
                object => $all_objects->{$key},
                old_id => $old_id,
            };
        } elsif ( $key =~ /^MT::Author#(\d+)$/ ) {
            # restore userpic association now
            my $new_author = $all_objects->{$key};
            if ( my $userpic_id = $new_author->userpic_asset_id ) {
                if ( my $new_asset = $all_objects->{'MT::Asset#' . $userpic_id} ) {
                    $new_author->userpic_asset_id( $new_asset->id );
                }
            }
            # also restore ids of favorite blogs
            if ( my $favorites = $new_author->favorite_blogs ) {
                my @new_favs;
                if ( @$favorites ) {
                    foreach my $old_id ( @$favorites ) {
                        my $blog = $all_objects->{'MT::Blog#' . $old_id};
                        push @new_favs, $blog->id if $blog;
                    }
                }
                $new_author->favorite_blogs(\@new_favs) if @new_favs;
            }
            $new_author->update;
            # call trigger to save meta
            $new_author->call_trigger('post_save', $new_author);
        }
    }

    my $i = 0;
    $callback->(
        MT->translate("Restoring asset associations ... ( [_1] )", $i++),
        'cb-restore-entry-asset'
    );
    for my $obj_id ( keys %entries ) {
        my $entry = $entries{$obj_id};

        my @placements = MT->model('objectasset')->load( {
            object_id => $obj_id, 
            object_ds => 'entry', 
            blog_id => $entry->blog_id
        });
        next unless @placements;

        my %related;
        for my $placement ( @placements ) {
            my $asset_hash = $assets{$placement->asset_id};
            next unless $asset_hash;
            $related{ $asset_hash->{old_id} } = $asset_hash->{object};
        }

        if ($entry->class == 'entry') {
            $callback->(
                MT->translate("Restoring asset associations in entry ... ( [_1] )", $i++),
                'cb-restore-entry-asset'
            );
        } else {
            $callback->(
                MT->translate("Restoring asset associations in page ... ( [_1] )", $i++),
                'cb-restore-entry-asset'
            );
        }
        
        for my $col ( qw( text text_more ) ) {
            my $text = $entry->$col;
            next unless $text;
            $text = _sync_asset_id( $text, \%related ); 
            $entry->$col($text);
        }
        $entry->update();  # directly call update to bypass processing in save()
    }
    $callback->( MT->translate("Done.") . "\n" );
    1;
}

sub _sync_asset_url {
    my ($text, $asset) = @_;

    my $filename = quotemeta(encode_url($asset->file_name));
    my $url = $asset->url;
    my $id = $asset->id;
    my @children = MT->model('asset')->load(
        { parent => $asset->id, blog_id => $asset->blog_id, class => '*' }
    );
    my %children = map {
        $_->id => {
            'filename' => quotemeta(encode_url($_->file_name)),
            'url' => $_->url
        }
    } @children;

    $text =~ s!<form([^>]*?\s)mt:asset-id=(["'])$id(["'])([^>]*?)>(.+?)</form>!
        my $result = '<form' . $1 . 'mt:asset-id=' . $2 . $id . $3 . $4 . '>';
        my $html = $5;
        $html =~ s#<a([^>]*? )href=(["'])[^>]+?/$filename(["'])([^>]*?)>#<a$1href=$2$url$3$4>#gim;
        $html =~ s#<img([^>]*? )src=(["'])[^>]+?/$filename(["'])([^>]*?)(/? *)>#<img$1src=$2$url$3$4$5>#gim;
        if ( %children ) {
            for my $child (values %children) {
                my $child_filename = $child->{filename};
                my $child_url = $child->{url};
                $html =~ s#<img([^>]*? )src=(["'])[^>]+?/$child_filename(["'])([^>]*?)>#<img$1src=$2$child_url$3$4>#gim;
                $html =~ s#<a([^>]*? )href=(["'])[^>]+?/$child_filename(["'])([^>]*?)>#<a$1href=$2$child_url$3$4>#gim;
                $html =~ s#<a([^>]*? )onclick=(["'])[^>]+?/$child_filename(["'])([^>]*?)>#<a$1onclick=$2$child_url$3$4>#gim;
            }
        }
        $result .= $html . '</form>';
        $result;
    !igem;
    $text;
}

sub cb_restore_asset {
    my $pkg = shift;
    my ($asset, $callback) = @_;
    
    my @placements = MT->model('objectasset')->load( {
        asset_id => $asset->id, 
        blog_id => $asset->blog_id
    });

    my $i = 0;
    $callback->(
        MT->translate('Restoring url of the assets ( [_1] )...', $i++),
        'cb-restore-asset-url'
    );
    for my $placement (@placements) {  
        next unless 'entry' eq $placement->object_ds;  
        my $entry = MT->model('entry')->load( $placement->object_id );  
        next unless $entry;  
        
        if ($entry->class == 'entry') {
            $callback->(
                MT->translate('Restoring url of the assets in entry ( [_1] )...', $i++),
                'cb-restore-asset-url'
            );
        } else {
            $callback->(
                MT->translate('Restoring url of the assets in page ( [_1] )...', $i++),
                'cb-restore-asset-url'
            );
        }
        for my $col ( qw( text text_more ) ) {
            my $text = $entry->$col;
            next unless $text;
            $text = _sync_asset_url( $text, $asset );
            $entry->$col($text);
        }
        $entry->update();  # directly call update to bypass processing in save()
    }
    $callback->( MT->translate("Done.") . "\n" );
    1;
}

sub _restore_asset_multi {
    my $class = shift;
    my ($asset_element, $objects, $errors, $callback, $blogs_meta) = @_;

    my $old_id = $asset_element->{asset_id};
    if (!defined($old_id)) {
        $callback->(MT->translate('ID for the file was not set.'));
        return 0;
    }
    my $asset_class = MT->model('asset');
    my $asset = $objects->{"$asset_class#$old_id"};
    unless (defined($asset)) {
        $callback->(MT->translate('The file ([_1]) was not restored.', $old_id));
        return 0;
    }

    my $fmgr;
    if (exists $blogs_meta->{$asset->blog_id}) {
        my $blog = MT->model('blog')->load($asset->blog_id)
            or return 0;

        my $meta = $blogs_meta->{$asset->blog_id};
        my $path = $asset->file_path;
        my $url = $asset->url;
        if (my $archive_path = $meta->{'archive_path'}) {
            my $old_archive_path = $meta->{'old_archive_path'};
            $path =~ s/\Q$old_archive_path\E/$archive_path/i;
            $asset->file_path($path);
        }
        if (my $archive_url = $meta->{'archive_url'}) {
            my $old_archive_url = $meta->{'old_archive_url'};
            $url =~ s/\Q$old_archive_url\E/$archive_url/i;
            $asset->url($url);
        }
        if (my $site_path = $meta->{'site_path'}) {
            my $old_site_path = $meta->{'old_site_path'};
            $path =~ s/\Q$old_site_path\E/$site_path/i;
            $asset->file_path($path);
        }
        if (my $site_url = $meta->{'site_url'}) {
            my $old_site_url = $meta->{'old_site_url'};
            $url =~ s/\Q$old_site_url\E/$site_url/i;
            $asset->url($url);
        }
        $callback->(MT->translate("Changing path for the file '[_1]' (ID:[_2])...", $asset->label, $asset->id));
        $asset->save or $callback->(MT->translate("failed") . "\n");
        $callback->(MT->translate("ok") . "\n");

        $fmgr = $blog->file_mgr;
    }
    my $file = $asset_element->{fh};
    $class->restore_asset($file, $asset, $old_id, $fmgr, $errors, $callback);
}

package MT::Object;

sub _is_element {
    my $obj = shift;
    my ($def) = @_;
    return (('text' eq $def->{type}) || (('string' eq $def->{type}) && (255 < $def->{size}))) ? 1 : 0;
}

sub to_xml {
    my $obj = shift;
    my ($namespace, $metacolumns) = @_;

    my $coldefs = $obj->column_defs;
    my $colnames = $obj->column_names;
    my $xml;

    my $elem = $obj->datasource;
    unless ( UNIVERSAL::isa( $obj, 'MT::Log' ) ) {
        if ( $obj->properties
          && ( my $ccol = $obj->properties->{class_column} ) ) {
            my $class = $obj->$ccol;
            $elem = $class if $class;
        }
    }

    $xml = '<' . $elem;
    $xml .= " xmlns='$namespace'" if defined($namespace) && $namespace;

    my (@elements, @blobs, @meta);
    for my $name (@$colnames) {
        if ($obj->column($name) || (defined($obj->column($name)) && ('0' eq $obj->column($name)))) {
            if ( ( $obj->properties->{meta_column} || '' ) eq $name ) {
                push @meta, $name;
                next;
            }
            elsif ($obj->_is_element($coldefs->{$name})) {
                push @elements, $name;
                next;
            } elsif ('blob' eq $coldefs->{$name}->{type}) {
                push @blobs, $name;
                next;
            }
            $xml .= " $name='" . MT::Util::encode_xml($obj->column($name), 1) . "'";
        }
    }
    my ( @meta_elements, @meta_blobs );
    if ( defined( $metacolumns ) && @$metacolumns ) {
        foreach my $metacolumn ( @$metacolumns ) {
            my $name = $metacolumn->{name};
            if ($obj->$name || (defined($obj->$name) && ('0' eq $obj->$name))) {
                if ( 'vclob' eq $metacolumn->{type} ) {
                    push @meta_elements, $name;
                }
                elsif ( 'vblob' eq $metacolumn->{type} ) {
                    push @meta_blobs, $name;
                }
                else {
                    $xml .= " $name='" . MT::Util::encode_xml($obj->$name, 1) . "'";
                }
            }
        }
    }
    $xml .= '>';
    $xml .= "<$_>" . MT::Util::encode_xml($obj->column($_), 1) . "</$_>" foreach @elements;
    require MIME::Base64;
    $xml .= "<$_>" . MIME::Base64::encode_base64($obj->column($_), '') . "</$_>" foreach @blobs;
    foreach my $meta_col (@meta) {
        my $hashref = $obj->$meta_col;
        $xml .= "<$meta_col>" . 
                MIME::Base64::encode_base64(MT::Serialize->serialize(\$hashref), '') .
                "</$meta_col>";
    }
    $xml .= "<$_>" . MT::Util::encode_xml($obj->$_, 1) . "</$_>" foreach @meta_elements;
    foreach my $vblob_col (@meta_blobs) {
        my $vblob = $obj->$vblob_col;
        $xml .= "<$vblob_col>" . 
                MIME::Base64::encode_base64(MT::Serialize->serialize(\$vblob), '') .
                "</$vblob_col>";
    }
    $xml .= '</' . $elem . '>';
    $xml;
}

sub parents {
    my $obj = shift;
    {};
}

sub _restore_id {
    my $obj = shift;
    my ($key, $val, $data, $objects) = @_;

    return 0 unless 'ARRAY' eq ref($val);
    return 1 if 0 == $data->{$key}; 

    my $new_obj;
    my $old_id = $data->{$key};
    foreach (@$val) {
        $new_obj = $objects->{"$_#$old_id"};
        last if $new_obj;
    }
    return 0 unless $new_obj;
    $data->{$key} = $new_obj->id;
    return 1;
}

sub restore_parent_ids {
    my $obj = shift;
    my ($data, $objects) = @_;

    my $parents = $obj->parents;
    my $count = scalar(keys %$parents);

    my $done = 0;
    while (my ($key, $val) = each(%$parents)) {
        $val = [ $val ] unless (ref $val);
        if ('ARRAY' eq ref($val)) {
            $done += $obj->_restore_id($key, $val, $data, $objects);
        }
        elsif ('HASH' eq ref($val)) {
            my $v = $val->{class};
            $v = [ $v ] unless (ref $v);
            my $result = 0;
            if (my $relations = $val->{relations}) {
                my $col = $relations->{key};
                my $ds = $data->{$col};
                my $ev = $relations->{$ds . '_id'};
                $ev = MT->model($ds) unless $ev;
                return 0 unless $ev;
                $ev = [ $ev ] unless (ref $ev);
                $done += $obj->_restore_id($key, $ev, $data, $objects);
            }
            else {
                $result = $obj->_restore_id($key, $v, $data, $objects);
                $result = 1 if exists($val->{optional}) && $val->{optional};
                $data->{$key} = -1 
                  if !$result && (exists($val->{orphanize}) && $val->{orphanize});
                $done += $result;
            }
        }
    }
    ($count == $done) ? 1 : 0;   
}

package MT::Blog;

sub backup_terms_args {
    my $class = shift;
    my ($blog_ids) = @_;

    if ( defined($blog_ids) && scalar(@$blog_ids) ) {
        return
          {
            terms => { id => $blog_ids }, 
            args => undef,
          };
    }
    else {
        return { terms => undef, args => undef };
    }
}

package MT::Tag;

sub backup_terms_args {
    my $class = shift;
    my ($blog_ids) = @_;

    if ( defined($blog_ids) && scalar(@$blog_ids) ) {
        return
          {
            terms => undef, 
            args =>
              {
                'join' =>
                  [
                    'MT::ObjectTag', 
                    'tag_id',
                    { blog_id => $blog_ids }, 
                    { unique => 1 }
                  ]
              }
          };
    }
    else {
        return { terms => undef, args => undef };
    }
}

package MT::Role;

sub backup_terms_args {
    my $class = shift;
    my ($blog_ids) = @_;

    if ( defined($blog_ids) && scalar(@$blog_ids) ) {
        return
          {
            terms => undef, 
            args =>
              {
                'join' =>
                  [
                    'MT::Association',
                    'role_id',
                    { blog_id => $blog_ids },
                    { unique => 1 }
                  ]
              }
          };
    }
    else {
        return { terms => undef, args => undef };
    }
}

package MT::Asset;

sub backup_terms_args {
    my $class = shift;
    my ($blog_ids) = @_;

    if ( defined($blog_ids) && scalar(@$blog_ids) ) {
        return
          {
            terms => { 'blog_id' => $blog_ids, 'class' => '*' }, 
            args => undef
          }
    }
    else {
        return { terms => { 'class' => '*' }, args => undef };
    }
}

my $assets_seen = {};

sub to_xml {
    my $obj = shift;
    my $xml = q();

    return $xml if exists $assets_seen->{$obj->id};

    if ($obj->parent) {
        my $parent = MT->model('asset')->load($obj->parent)
            or return $xml;
        $xml .= $parent->to_xml(@_);
        $xml .= "\n";
    }

    $xml .= $obj->SUPER::to_xml(@_);
    $assets_seen->{$obj->id} = 1;
    $xml;
}

sub parents {
    my $obj = shift;
    {
        blog_id => MT->model('blog'),
        parent  => MT->model('asset')
    };
}

package MT::PluginData;

sub backup_terms_args {
    my $class = shift;
    my ($blog_ids) = @_;

    return { terms => undef, args => undef };
}

sub restore_parent_ids {
    my $obj = shift;
    my ($data, $objects) = @_;

    if ($data->{key} =~ /^configuration:blog:(\d+)$/i) {
        my $new_blog = $objects->{'MT::Blog#' . $1};
        if ($new_blog) {
            $data->{key} = 'configuration:blog:' . $new_blog->id;
        }
    }
    return 1;
}

package MT::Association;

sub restore_parent_ids {
    my $obj = shift;
    my ($data, $objects) = @_;

    my ($u, $b, $g, $r) = (0, 0, 0, 0);

    my $processor = sub {
        my ($elem) = @_;
        my $class = MT->model($elem);
        my $old_id = $data->{$elem . '_id'};
        my $new_obj = $objects->{"$class#$old_id"};
        return 0 unless defined($new_obj) && $new_obj;
        $data->{$elem . '_id'} = $new_obj->id;
        return 1;
    };

    $u = $processor->('author');
    $g = $processor->('group');
    $b = $processor->('blog');
    $r = $processor->('role');

    # Combination allowed are:
    # USER_BLOG_ROLE  => 1;
    # GROUP_BLOG_ROLE => 2;
    # USER_GROUP      => 3;
    # USER_ROLE       => 4;
    # GROUP_ROLE      => 5;

    ($u && $g) || ($u && $r) || ($g && $r) ? 1 : 0; # || ($u && $b && $r) || ($g && $b && $r)
}

package MT::Category;

my $category_seen = {};

sub to_xml {
    my $obj = shift;
    my $xml = q();

    return $xml if exists $category_seen->{$obj->id};
    
    if ('0' ne $obj->parent) {
        $xml .= $obj->parent_category->to_xml(@_);
        $xml .= "\n";
    }

    $xml .= $obj->SUPER::to_xml(@_);
    $category_seen->{$obj->id} = 1;
    $xml;
}

sub parents {
    my $obj = shift;
    {
        blog_id => MT->model('blog'),
        parent  => [ MT->model('category'), MT->model('folder') ],
    };
}

package MT::Comment;

sub parents {
    my $obj = shift;
    {
        entry_id => [ MT->model('entry'), MT->model('page') ],
        blog_id => MT->model('blog'),
        commenter_id => { class => MT->model('author'), optional => 1 },
    };
}

package MT::Entry;

sub parents {
    my $obj = shift;
    {
        blog_id => MT->model('blog'),
        author_id => { class => MT->model('author'), optional => 1, orphanize => 1 },
    };
}

package MT::FileInfo;

sub parents {
    my $obj = shift;
    {
        entry_id => { class => [ MT->model('entry'), MT->model('page') ], optional => 1 },
        blog_id => { class => MT->model('blog'), optional => 1 },
        templatemap_id => { class => MT->model('templatemap'), optional => 1 },
        template_id => { class => MT->model('template'), optional => 1 },
        category_id => { class => [ MT->model('category'), MT->model('folder') ], optional => 1 },
        author_id => { class => MT->model('author'), optional => 1 },
    };
}

package MT::Notification;

sub parents {
    my $obj = shift;
    {
        blog_id => MT->model('blog'),
    };
}

package MT::ObjectTag;

sub parents {
    my $obj = shift;
    {
        blog_id => MT->model('blog'),
        tag_id => MT->model('tag'),
        object_id => { relations => {
            key => 'object_datasource',
            entry_id => [ MT->model('entry'), MT->model('page') ],
        }}
    };
}

package MT::Permission;

sub parents {
    my $obj = shift;
    {
        blog_id => { class => MT->model('blog'), optional => 1 },
        author_id => { class => MT->model('author'), optional => 1 },
    };
}

package MT::Placement;

sub parents {
    my $obj = shift;
    {
        category_id => [ MT->model('category'), MT->model('folder') ],
        blog_id => MT->model('blog'),
        entry_id => [ MT->model('entry'), MT->model('page') ],
    };
}

package MT::TBPing;

sub parents {
    my $obj = shift;
    {
        blog_id => MT->model('blog'),
        tb_id => MT->model('trackback'),
    };
}

package MT::Template;

sub parents {
    my $obj = shift;
    {
        blog_id => MT->model('blog'),
    };
}

package MT::TemplateMap;

sub parents {
    my $obj = shift;
    {
        blog_id => MT->model('blog'),
        template_id  => MT->model('template')
    };
}

package MT::Trackback;

sub restore_parent_ids {
    my $obj = shift;
    my ($data, $objects) = @_;

    my $result = 0;
    my $blog_class = MT->model('blog');
    my $new_blog = $objects->{$blog_class . '#' . $data->{blog_id}};
    if ($new_blog) {
        $data->{blog_id} = $new_blog->id;
    } else {
        return 0;
    }                            
    if (my $cid = $data->{category_id}) {
        my $cat_class = MT->model('category');
        my $new_obj = $objects->{$cat_class . '#' . $cid};
        unless ($new_obj) {
            $cat_class = MT->model('folder');
            $new_obj = $objects->{$cat_class . '#' . $cid};
        }
        if ($new_obj) {
            $data->{category_id} = $new_obj->id;
            $result = 1;
        }
    } elsif (my $eid = $data->{entry_id}) {
        my $entry_class = MT->model('entry');
        my $new_obj = $objects->{$entry_class . '#' . $eid};
        unless ($new_obj) {
            $entry_class = MT->model('page');
            $new_obj = $objects->{$entry_class . '#' . $eid};
        }
        if ($new_obj) {
            $data->{entry_id} = $new_obj->id;
            $result = 1;
        }
    }
    $result;
}

package MT::ObjectAsset;

sub parents {
    my $obj = shift;
    {
        blog_id => MT->model('blog'),
        asset_id => MT->model('asset'),
        object_id => { relations => {
            key => 'object_ds',
            entry_id => [ MT->model('entry'), MT->model('page') ],
        }}
    };
}

package MT::ObjectScore;

sub backup_terms_args {
    my $class = shift;
    my ($blog_ids) = @_;

    return { terms => undef, args => undef };
}

sub parents {
    my $obj = shift;
    {
        author_id => MT->model('author'),
        object_id => { relations => {
            key => 'object_ds',
            entry_id => [ MT->model('entry'), MT->model('page') ],
        }}
    };
}

1;
__END__

=head1 NAME

MT::BackupRestore

=head1 METHODS

=head2 backup

TODO Backup I<MT::Tag>, I<MT::Author>, I<MT::Blog>, I<MT::Role>, 
I<MT::Category>, I<MT::Asset>, and I<MT::Entry>.  Each object will
be back up by MT::Object#to_xml call, which will do the actual
Object ==>> XML serialization.

=head2 restore_file

TODO Restore MT system from an XML file which contains MT backup
information (created by backup subroutine).

=head2 restore_process_single_file

TODO A method which will do the actual heavy lifting of the
process to restore objects from an XML file.  Returns array of blog_ids
which are restored in the very session, and hash of asset_ids.

=head2 restore_directory

TODO A method which reads specified directory, find a manifest file,
and do the multi-file restore operation directed by the manifest file.

=head2 restore_object_asset

Accepts an asset object just restored, populate associated entries,
and scan text and text_more for each entry.  If association marker
(<form> tag) is found, replace asset id and URL to the new ones.

=head2 restore_asset

TODO A method which restores the assets' actual files to the
specified directory.  It also creates subdirectory by request.

=head2 process_manifest

TODO A method which is called from MT::App::CMS to process an uploaded
manifest file which is to be the source of the multi-file restore
operation in the MT::App::CMS.

=head1 Callbacks

For plugins which uses MT::Object-derived types, backup and restore
operation call callbacks for plugins to inject XMLs so they are
also backup, and read XML to restore objects so they are also restored.

Callbacks called by the package are as follows:

=over 4

=item Backup
    
Calling convention is:

    callback($cb, $blog_ids, $progress)

The callback is used for MT::Object-derived types used by plugins
to be backup.  The callback must return the object's XML representation
in a string, or 1 for nothing.  $blog_ids has an ARRAY reference to
blog_ids which indicates what weblog a user chose to backup.  It may
be an empty array if a user chose Everything.  $progress is a CODEREF
used to report progress to the user.

If a plugin has an MT::Object derived type, the plugin will register 
a callback to Backup callback, and Backup process will call the callbacks
to give plugins a chance to add their own data to the backup file.
Otherwise, plugin's object classes is likely be ignored in backup operation.

=item Restore.<element_name>:<xmlnamespace>

Restore callbacks are called in convention like below:

    callback($cb, $data, $objects, $deferred, $callback);

Where $data is a parameter which was passed to XML::SAX::Base's 
start_element callback method.

$objects is an hash reference which contains all the restored objects
in the restore session.  The hash keys are stored in the format
MT::ObjectClassName#old_id, and hash values are object reference
of the actually restored objects (with new id).  Old ids are ids
which are stored in the XML files, while new ids are ids which
are restored.

$deferred is an hash reference which contains information about
restore-deferred objects.  Deferred objects are those objects
which appeared in the XMl file but could not be restored because
any parent objects are missing.  The hash keys are stored in
the format MT::ObjectClassName#old_id and hash values are 1.

$callback is a code reference which will print out the passed paramter.
Callback method can use this to communicate with users.

If a plugin has an MT::Object derived type, the plugin will register 
a callback to Restore.<element_name>:<xmlnamespace> callback, 
so later the restore operation will call the callback function with 
parameters described above.  XML Namespace is required to be registered, 
so an xml node can be resolved into what plugins to be called back, 
and can be distinguished the same element name with each other.

=item restore
    
Calling convention is:

    callback($cb, $objects, $deferred, $errors, $callback);

This callback is called when all of the XML files in the particular
restore session are restored, thus, when $objects and $deferred
would not have any more objects in them.  This callback is useful
for object classes which have relationships with other classes,
for the kind of classes may not be able to handle relationship
correctly until the associated objects would be successfully
restored.

NOTE that this callback is called BEFORE blogs' site_path and
site_url are updated.  Therefore, blog objects and other objects
which contains path information such as assets still have old
url and path in I<$objects>.

$objects is an hash reference which contains all the restored objects
in the restore session.  The hash keys are stored in the format
MT::ObjectClassName#old_id, and hash values are object reference
of the actually restored objects (with new id).  Old ids are ids
which are stored in the XML files, while new ids are ids which
are restored.

$deferred is an hash reference which contains information about
restore-deferred objects.  Deferred objects are those objects
which appeared in the XMl file but could not be restored because
any parent objects are missing.  The hash keys are stored in
the format MT::ObjectClassName#old_id and hash values are 1.

$callback is a code reference which will print out the passed paramter.
Callback method can use this to communicate with users.

=item restore_asset
    
Calling convention is:

    callback($cb, $asset, $callback);

This callback is called when asset's actual file is restored.
$asset has new url and path.

$callback is a code reference which will print out the passed paramter.
Callback method can use this to communicate with users.

=head1 AUTHOR & COPYRIGHT

Please see L<MT/AUTHOR & COPYRIGHT>.

=cut