Daizu::File - class representing files in working copies

package Daizu::File;
use warnings;
use strict;

use Carp qw( croak );
use Carp::Assert qw( assert DEBUG );
use XML::LibXML;
use Encode qw( encode decode );
use URI;
use Daizu::Wc;
use Daizu::Util qw(
    trim trim_with_empty_null pgregex_escape url_encode url_decode
    parse_db_datetime
    db_select db_select_col db_insert db_update transactionally
    wc_file_data
    instantiate_generator
    expand_xinclude
);
use Daizu::HTML qw( dom_body_to_html4 absolutify_links );

sub new
{
    my ($class, $cms, $file_id) = @_;
    croak 'usage: Daizu::File->new($cms, $file_id)'
        unless defined $cms && ref $cms && defined $file_id;
    my $db = $cms->{db};

    my $record = $db->selectrow_hashref(q{
                select wc_id, guid_id, parent_id,
                              is_dir, name, path,
                              cur_revnum, modified, deleted,
                              generator, root_file_id, custom_url, article, retired,
                              title, short_title, description,
                              issued_at, modified_at,
                              image_width, image_height,
                              data_len, content_type,
                              article_pages_url
                from wc_file
                where id = ?
        }, undef, $file_id);
    croak "no file found with ID $file_id"
        unless defined $record;

    for (qw( title short_title description )) {
        $record->{$_} = decode('UTF-8', $record->{$_}, Encode::FB_CROAK)
            if defined $record->{$_};
    }

    return bless {
        cms => $cms,
        db => $db,
        id => $file_id,
        %$record,
    }, $class;
}

sub data
{
    my ($self) = @_;
    return wc_file_data($self->{db}, $self->{id});
}

sub wc
{
    my ($self) = @_;
    return Daizu::Wc->new($self->{cms}, $self->{wc_id});
}

sub guid_uri
{
    my ($self) = @_;
    return db_select($self->{db}, file_guid => $self->{guid_id}, 'uri');
}

sub directory_path
{
    my ($self) = @_;
    my $path = $self->{path};
    return $path if $self->{is_dir};
    return $path =~ m!^(.*)/[^/]+\z! ? $1 : '';
}

sub permalink
{
    my ($self) = @_;
    return URI->new($self->{article_pages_url})
        if $self->{article};
    my ($permalink) = $self->generator->urls_info($self);
    return unless defined $permalink;
    return $permalink->{url};
}

sub urls_in_db
{
    my ($self, $method, $argument) = @_;

    my %criteria = (
        wc_id => $self->{wc_id},
        guid_id => $self->{guid_id},
        status => 'A',
    );

    $criteria{method} = $method
        if defined $method;
    $criteria{argument} = $argument
        if defined $argument;

    return db_select_col($self->{db}, url => \%criteria, 'url');
}

# Used by article_urls() below.  Uses some crufty heuristics to decide
# how pages (other than the first page) of articles should be referenced.
# $url should be the URL of the article's first page, which is likely to
# be the empty string or 'filename.html', although it could be an absolute
# URL.  It's up to the generator class.
sub _pagify_url
{
    my ($url, $page) = @_;
    assert($page > 0) if DEBUG;
    assert($url ne '') if DEBUG;
    return $url if $page == 1;
    return "$url/page$page.html" if $url =~ m!/$!;
    $url =~ s!\.([^/.]+)$!-page$page.$1! or $url .= "-page$page.html";
    return $url;
}

sub article_urls
{
    my ($self) = @_;
    croak "file is not an article"
        unless $self->{article};

    $self->_find_content_marks;     # need to know how many pages

    my @page_urls = map {
        {
            url => _pagify_url($self->{article_pages_url}, $_),
            generator => (ref $self->generator),
            method => 'article',
            argument => ($_ == 1 ? '' : $_),
            type => 'text/html',
        }
    } (1 .. scalar @{$self->{page_start}});

    return @page_urls, $self->article_extra_urls;
}

sub parent
{
    my ($self) = @_;
    return unless defined $self->{parent_id};
    return Daizu::File->new($self->{cms}, $self->{parent_id});
}

sub file_at_path
{
    my ($self, $path) = @_;
    my $wc_id = $self->{wc_id};

    # The 'daizu' scheme is used for XInclude expansion, so might as well
    # use it here too.  It doesn't really matter, we just want to get the
    # URI module to resolve the relative path for us.
    my $base = 'daizu:///' . url_encode($self->{path});
    $base .= '/' if $self->{is_dir};

    $path =~ s!/\./!/!g;
    my $abs_path = URI->new($path)->abs($base)->path;
    $abs_path =~ s!^/!!;
    $abs_path = url_decode($abs_path);

    my $wc = Daizu::Wc->new($self->{cms}, $self->{wc_id});
    return $wc->file_at_path($abs_path);
}

sub issued_at
{
    my ($self) = @_;
    return parse_db_datetime($self->{issued_at});
}

sub modified_at
{
    my ($self) = @_;
    return parse_db_datetime($self->{modified_at});
}

sub property
{
    my ($self, $name) = @_;
    my $value = db_select($self->{db}, 'wc_property',
        { file_id => $self->{id}, name => $name },
        'value',
    );
    $value = trim_with_empty_null($value);
    return decode('UTF-8', $value, Encode::FB_CROAK);
}

sub most_specific_property
{
    my ($file, $name) = @_;

    while (defined $file) {
        my $value = $file->property($name);
        if (defined $value && $value =~ /\S/) {
            $value = trim($value);
            return decode('UTF-8', $value, Encode::FB_CROAK);
        }
        $file = $file->parent;
    }

    return undef;
}

sub least_specific_property
{
    my ($file, $name) = @_;

    my $best;
    while (defined $file) {
        my $value = $file->property($name);
        $best = trim($value)
            if defined $value && $value =~ /\S/;
        $file = $file->parent;
    }

    return decode('UTF-8', $best, Encode::FB_CROAK);
}

sub homepage_file
{
    my ($file) = @_;

    my $best;
    while (defined $file) {
        $best = $file if defined $file->{custom_url};
        $file = $file->parent;
    }

    return $best;
}

sub title { shift->{title} }

sub short_title { shift->{short_title} }

sub description { shift->{description} }

sub generator
{
    my ($self) = @_;
    return $self->{generator_obj} if exists $self->{generator_obj};
    my $cms = $self->{cms};

    my $root_file = $self;
    $root_file = Daizu::File->new($cms, $self->{root_file_id})
        if defined $self->{root_file_id};
    my $generator = instantiate_generator($cms, $self->{generator},
                                          $root_file);

    $self->{generator_obj} = $generator;
    return $generator;
}

sub update_loaded_article_in_db
{
    my ($self) = @_;
    return unless $self->{article};
    return transactionally($self->{db}, \&_update_loaded_article_in_db_txn,
                           $self);
}

sub _update_loaded_article_in_db_txn
{
    my ($self) = @_;
    my $cms = $self->{cms};

    my $mime_type = $self->{content_type};
    if (!defined $mime_type) {
        # Articles must have a mime type, but allow a default based on file
        # extension for the built-in XHTML format.
        croak "article in file '$self->{path}' has no mime type specified"
            unless $self->{name} =~ /\.html?$/i;
        $mime_type = 'text/html';
    }
    $mime_type =~ m!^(.+?)/!
        or croak "bad article mime type '$mime_type' in file '$self->{path}'";
    my $mime_type_family = "$1/*";

    # Search through applicable MIME type patterns.
    my $file_path = $self->{path};
    for my $match ($mime_type, $mime_type_family, '*') {
        next unless exists $cms->{article_loaders}{$match};
        my $plugins = $cms->{article_loaders}{$match};

        # Search through applicable paths, sorting in reverse order of length
        # so that the most specific configuration gets tested first.
        for my $match_path (sort { length $b <=> length $a } keys %$plugins) {
            next unless
                $match_path eq '' || $match_path eq $file_path ||
                substr($file_path, 0, length $match_path + 1) eq "$match_path/";

            # Search through the plugins we've found to find one which
            # accepts the file.
            for my $handler (@{$plugins->{$match_path}}) {
                my ($object, $method) = @$handler;
                my $article = $object->$method($cms, $self);
                next unless $article;
                croak "bad return value '$article' from article loader" .
                      " '$object->$method"
                    unless ref($article) eq 'HASH';

                $self->_expand_article_xinclude($article);
                $self->_filter_loaded_article($article);
                $self->_save_article_content($article);

                return;
            }
        }
    }

    die "can't load article $self->{id}," .
        " don't know how to handle content type '$mime_type'";
}

sub _expand_article_xinclude
{
    my ($self, $article) = @_;

    my @included_files = expand_xinclude($self->{db}, $article->{content},
                                         $self->{wc_id}, $self->{path});
    $article->{included_files} = \@included_files
        if @included_files;
}

sub _filter_loaded_article
{
    my ($self, $article) = @_;
    my $cms = $self->{cms};

    # Filter through plugins.
    my $doc = $article->{content};
    my $file_path = $self->{path};

    # Go through the known filters in an arbitrary order.
    FILTER: for my $plugins (values %{$cms->{html_dom_filters}}) {
        # Search through applicable paths, sorting in reverse order of length
        # so that the most specific configuration gets tested first.
        for my $match_path (sort { length $b <=> length $a } keys %$plugins) {
            next unless
                $match_path eq '' || $match_path eq $file_path ||
                substr($file_path, 0, length $match_path + 1) eq "$match_path/";

            my ($object, $method) = @{$plugins->{$match_path}};
            my $result = $object->$method($cms, $self, $doc);
            die "filter plugin $object->$method didn't return any content"
                unless defined $result && defined $result->{content};

            $doc = $result->{content};
            push @{$article->{extra_urls}}, @{$result->{extra_urls}}
                if defined $result->{extra_urls};
            push @{$article->{extra_templates}}, @{$result->{extra_templates}}
                if defined $result->{extra_templates};

            # Only execute the best match for each filter.
            next FILTER;
        }
    }

    $article->{content} = $doc;
}

# Save the new article content and associated metadata from the loader plugin
# in the database.  Also update this Daizu::File object to contain the new
# information, and to invalidate caches of some stuff.
sub _save_article_content
{
    my ($self, $art) = @_;
    my $db = $self->{db};

    my %meta;
    while (my ($property, $column) = each %Daizu::OVERRIDABLE_PROPERTY) {
        my $value = db_select($db, 'wc_property',
            { file_id => $self->{id}, name => $property },
            'value',
        );
        $value = $art->{$column}
            unless defined $value;

        $self->{$column} = $meta{$column} = trim_with_empty_null($value);
    }

    my $pages_url = $art->{pages_url};
    $pages_url = '' unless defined $pages_url;
    $self->{article_pages_url} = $pages_url,

    my $xml = $art->{content}->documentElement->toString;
    croak "article can't be loaded because the result contains a nul byte"
        if $xml =~ /\0/;
    delete $self->{article_doc};
    delete $self->{snippet_doc};
    delete $self->{fold};
    delete $self->{page_start};

    db_update($db, wc_file => $self->{id},
        %meta,
        article_content => encode('UTF-8', $xml, Encode::FB_CROAK),
    );

    $db->do(q{
                delete from wc_article_extra_url
                where file_id = ?
        }, undef, $self->{id});
    delete $self->{article_extra_urls};

    if ($art->{extra_urls}) {
        for (@{$art->{extra_urls}}) {
            my $arg = $_->{argument};
            $arg = '' if !defined $arg;
            $db->do(q{
                                insert into wc_article_extra_url
                                        (file_id, url, content_type, generator, method,
                                          argument)
                                        values (?, ?, ?, ?, ?, ?)
                        }, undef, $self->{id}, $_->{url}, $_->{type},
                      $_->{generator}, $_->{method}, $arg);
        }
    }

    $db->do(q{
                delete from wc_article_extra_template
                where file_id = ?
        }, undef, $self->{id});
    delete $self->{article_extra_templates};

    if ($art->{extra_templates}) {
        for (@{$art->{extra_templates}}) {
            $db->do(q{
                                insert into wc_article_extra_template
                                        (file_id, filename)
                                        values (?, ?)
                        }, undef, $self->{id}, $_);
        }
    }

    $db->do(q{
                delete from wc_article_included_files
                where file_id = ?
        }, undef, $self->{id});

    if ($art->{included_files}) {
        for (@{$art->{included_files}}) {
            $db->do(q{
                                insert into wc_article_included_files
                                        (file_id, included_file_id)
                                        values (?, ?)
                        }, undef, $self->{id}, $_);
        }
    }

    my $base_url = $self->generator->base_url($self);
    $pages_url = URI->new_abs($pages_url, $base_url);
    db_update($db, wc_file => $self->{id},
        article_pages_url => $pages_url,
    );
}

sub _find_content_marks
{
    my ($self) = @_;

    # Find out where fold and page breaks are, and remove the markers.
    my $node = $self->article_doc->documentElement->firstChild;
    my $fold;
    my @page_start;
    push @page_start, $node;
    while (defined $node) {
        my $next = $node->nextSibling;
        last unless defined $next;

        if ($node->nodeType == XML_ELEMENT_NODE) {
            my $ns = $node->namespaceURI;
            push @page_start, $next
                if defined $ns && $ns eq $Daizu::HTML_EXTENSION_NS &&
                   $node->localname eq 'page';
            if (defined $ns && $ns eq $Daizu::HTML_EXTENSION_NS &&
                $node->localname eq 'fold')
            {
                croak "only one <daizu:fold/> is allowed in an article"
                    if defined $fold;
                $fold = $node;
            }
        }

        $node = $next;
    }

    $self->{fold} = defined $fold ? $fold
                  : @page_start > 1 ? $page_start[1]->previousSibling
                  : undef;
    $self->{page_start} = \@page_start;
}

sub article_doc
{
    my ($self) = @_;
    croak "can't load article content for '$self->{path}', it's not an article"
        unless $self->{article};
    return $self->{article_doc} if exists $self->{article_doc};

    my ($xml) = db_select($self->{db}, wc_file => $self->{id},
                          'article_content');
    assert(defined $xml) if DEBUG;

    my $parser = XML::LibXML->new;
    eval { $self->{article_doc} = $parser->parse_string($xml) };
    croak "error parsing stored article_content of '$self->{path}': $@"
        if $@;

    return $self->{article_doc};
}

sub article_body
{
    my ($self) = @_;
    return $self->article_doc->documentElement;
}

sub article_content_html4
{
    my ($self, $page_num) = @_;
    $self->_find_content_marks;

    my ($start_node, $end_node);
    if (defined $page_num && $page_num ne '') {
        croak "page $page_num out of range for this article"
            if $page_num < 1 || $page_num > @{$self->{page_start}};
        $start_node = $self->{page_start}[$page_num - 1];
        $end_node = $self->{page_start}[$page_num];
    }

    return dom_body_to_html4($self->article_doc, $start_node, $end_node);
}

sub article_extract
{
    my ($self) = @_;

    my $block_elem = $self->article_body->firstChild;

    my $max_words = 50;     # TODO - make configurable.
    my @words;

    while (@words <= $max_words && defined $block_elem) {
        $block_elem = $block_elem->nextSibling, next
            unless $block_elem->nodeType == XML_ELEMENT_NODE;

        $words[-1] .= "\n\n" if @words && $words[-1] !~ /\n\z/;

        my @new_words = split ' ', trim($block_elem->textContent);
        while (@words <= $max_words && @new_words) {
            push @words, shift @new_words;
        }

        $block_elem = $block_elem->nextSibling;
    }

    if (@words > $max_words) {
        pop @words;
        push @words, "\x{2026}";
    }

    my $text = join ' ', @words;
    $text =~ s/\n /\n/g;
    return $text;
}

sub article_extra_urls
{
    my ($self) = @_;
    return unless $self->{article};

    if (!exists $self->{article_extra_urls}) {
        my $sth = $self->{db}->prepare(q{
                        select *
                        from wc_article_extra_url
                        where file_id = ?
                });
        $sth->execute($self->{id});

        my @extra;
        while (my $r = $sth->fetchrow_hashref) {
            push @extra, {
                url => $r->{url},
                type => $r->{content_type},
                generator => $r->{generator},
                method => $r->{method},
                argument => $r->{argument},
            };
        }

        $self->{article_extra_urls} = \@extra;
    }

    return @{$self->{article_extra_urls}};
}

sub article_extra_templates
{
    my ($self) = @_;
    return unless $self->{article};

    if (!exists $self->{article_extra_templates}) {
        my $sth = $self->{db}->prepare(q{
                        select filename
                        from wc_article_extra_template
                        where file_id = ?
                });
        $sth->execute($self->{id});

        my @extra;
        while (my ($filename) = $sth->fetchrow_array) {
            push @extra, $filename
        }

        $self->{article_extra_templates} = \@extra;
    }

    return @{$self->{article_extra_templates}};
}

sub tags
{
    my ($self) = @_;

    my $sth = $self->{db}->prepare(q{
                select t.tag, ft.original_spelling
                from tag t
                inner join wc_file_tag ft on ft.tag = t.tag
                where ft.file_id = ?
                order by t.tag
        });
    $sth->execute($self->{id});

    my @tags;
    while (my $row = $sth->fetchrow_hashref) {
        $row->{$_} = decode('UTF-8', $row->{$_}, Encode::FB_CROAK)
            for qw( title short_title description );
        push @tags, { %$row };
    }

    return \@tags;
}

sub article_snippet
{
    my ($self) = @_;
    return $self->{snippet_doc} if exists $self->{snippet_doc};

    my $whole_doc = $self->article_doc;
    $self->_find_content_marks;
    my $fold = $self->{fold};
    return $whole_doc
        unless defined $fold;

    my $snippet_doc = XML::LibXML::Document->new('1.0', 'UTF-8');
    my $body = $snippet_doc->createElementNS('http://www.w3.org/1999/xhtml',
                                             'body');
    $snippet_doc->setDocumentElement($body);

    my $elem = $whole_doc->documentElement->firstChild;
    while (defined $elem && !$elem->isSameNode($fold)) {
        $body->appendChild($elem->cloneNode(1));
        $elem = $elem->nextSibling;
    }

    return $self->{snippet_doc} = $snippet_doc;
}

sub article_snippet_html4
{
    my ($self) = @_;
    my $snippet_doc = $self->article_snippet;
    $self->{snippet_is_not_whole_article} = 1
        unless $snippet_doc->isSameNode($self->article_doc);

    # This is going to be shown on the homepage or something, so links won't
    # be relative to the output page's URL.
    absolutify_links($snippet_doc, $self->permalink);

    # TODO - this could be more efficient if we passed in the fold position.
    return dom_body_to_html4($snippet_doc);
}

sub authors
{
    my ($self) = @_;
    my $db = $self->{db};

    # Build a PostgreSQL regular expression which will be used to select
    # all the 'person_info' records with a path which applies to the file,
    # in order to select the most specific one (with the longest path).
    my @path = map { pgregex_escape($_) }
               split '/', $self->{path};
    my $path_regex = '^(' . join('(/', @path) . '$' . ('|$)' x @path);

    my $sth = $db->prepare(q{
                select person_id
                from file_author
                where file_id = ?
                order by pos
        });
    $sth->execute($self->{id});

    my @author;
    while (my ($id) = $sth->fetchrow_array) {
        my $info = $db->selectrow_hashref(q{
                        select p.id, p.username, i.name, i.email, i.uri
                        from person p
                        inner join person_info i on i.person_id = p.id
                        where p.id = ?
                            and i.path ~ ?
                        order by length(i.path) desc
                }, undef, $id, $path_regex);
        croak "no 'person_info' record for user $id at path '$self->{path}'"
            unless defined $info;
        for (qw( username name )) {
            $info->{$_} = decode('UTF-8', $info->{$_}, Encode::FB_CROAK);
        }
        push @author, { %$info };
    }

    return \@author;
}

sub update_urls_in_db
{
    my ($self, $dup_urls) = @_;
    return transactionally($self->{db}, \&_update_urls_in_db_txn, $self,
                           $dup_urls);
}

sub _update_urls_in_db_txn
{
    my ($self, $dup_urls) = @_;
    my $db = $self->{db};

    # Get information about the URLs that we currently have for this file.
    my $sth = $db->prepare(q{
                select *
                from url
                where wc_id = ?
                    and guid_id = ?
        });
    $sth->execute($self->{wc_id}, $self->{guid_id});

    my (%old_active, %old_redirect, %old_gone);
    while (my $r = $sth->fetchrow_hashref) {
        my $hash = $r->{status} eq 'A' ? \%old_active :
                   $r->{status} eq 'R' ? \%old_redirect :
                                         \%old_gone;
        $hash->{$r->{url}} = { %$r };
    }

    # Keep track of whether the set of redirects or gone files have changed,
    # which might mean that the caller will need to regenerate some redirect
    # files.  The keys are the filenames which need updating, and the values
    # are the output configuration hashes where they were found.
    my (%redirects_changed, %gone_changed);

    # Track changes to URLs for the publishing process.  Each one of these
    # has the URL as the key and the URL info hash as the value.  For changed
    # URLs the new URL and URL info is used in the key and value, but the value
    # also contains a key called 'old_url_info'.
    # Note that changed URLs are ones where a redirect has been created, and
    # changes of URL ownership (one file deactivates it and another file
    # reactivates the same URL) are not recorded.
    my (%url_activated, %url_deactivated, %url_changed);

    # Put the new URLs in the database.  Add the 'id' of each one to the
    # information in @new_url.
    my @new_url = $self->generator->urls_info($self);
    for (@new_url) {
        my $url = $_->{url};
        if (exists $old_active{$url}) {
            # Was active, and still is.  If a duplicate URL has been created
            # by another file then at this point we know there's no chance
            # of it being resolved, so signal an error.
            croak "new URL '$url' would conflict with existing URL"
                if defined $dup_urls && exists $dup_urls->{$url};
            $_->{id} = $old_active{$url}{id};
            db_update($db, url => $_->{id},
                method => $_->{method},
                argument => $_->{argument},
                content_type => $_->{type},
            );
            delete $old_active{$url};
        }
        elsif (exists $old_redirect{$url}) {
            # Was a redirect, but now active again.
            assert(!defined $dup_urls || !exists $dup_urls->{$url}) if DEBUG;
            $_->{id} = $old_redirect{$url}{id};
            db_update($db, url => $_->{id},
                method => $_->{method},
                argument => $_->{argument},
                content_type => $_->{type},
                status => 'A',
                redirect_to_id => undef,
            );
            $url_activated{$url} = $_;
            delete $old_redirect{$url};
            $self->_update_rewrite(\%redirects_changed, 'redirect', $url);
        }
        elsif (exists $old_gone{$url}) {
            # Was gone, but has come back.
            assert(!defined $dup_urls || !exists $dup_urls->{$url}) if DEBUG;
            $_->{id} = $old_gone{$url}{id};
            db_update($db, url => $_->{id},
                method => $_->{method},
                argument => $_->{argument},
                content_type => $_->{type},
                status => 'A',
            );
            $url_activated{$url} = $_;
            delete $old_gone{$url};
            $self->_update_rewrite(\%gone_changed, 'gone', $url);
        }
        else {
            # New URL.  It might replace a non-active one belonging to a
            # different file.
            my ($id, $status) = db_select($db, 'url',
                { wc_id => $self->{wc_id}, url => $url },
                qw( id status ),
            );
            if (defined $id && !(defined $dup_urls && $status eq 'A')) {
                if ($status eq 'A') {
                    croak "new URL '$url' would conflict with existing URL";
                }
                elsif ($status eq 'R') {
                    $self->_update_rewrite(\%redirects_changed, 'redirect',
                                           $url);
                }
                elsif ($status eq 'G') {
                    $self->_update_rewrite(\%gone_changed, 'gone', $url);
                }

                # %$dup_urls should never contain a non-active URL.
                assert(!defined $dup_urls || !exists $dup_urls->{$url})
                    if DEBUG;

                # Write the new active URL over the top of an old inactive one.
                $_->{id} = $id;
                db_update($db, url => $id,
                    guid_id => $self->{guid_id},
                    generator => $_->{generator},
                    method => $_->{method},
                    argument => $_->{argument},
                    content_type => $_->{type},
                    status => 'A',
                    redirect_to_id => undef,
                );
                $url_activated{$url} = $_;
            }
            else {
                if (defined $id) {
                    assert(defined $dup_urls) if DEBUG;

                    # We already have one duplicate for this, so it can't
                    # possibly be resolved by deactivating the existing one.
                    croak "new URL '$url' would conflict with existing URL"
                        if exists $dup_urls->{$url};

                    # The new URL is a duplicate of an existing one which is
                    # still active, but our caller has let it be known that
                    # there are multiple files being updated at once, so keep
                    # information about the new URL in the hopes that the old
                    # one will later be deactivated, allowing it to be replaced
                    # with this one.
                    $_->{id} = $id;
                    $dup_urls->{$url} = {
                        id => $id,
                        guid_id => $self->{guid_id},
                        generator => $_->{generator},
                        method => $_->{method},
                        argument => $_->{argument},
                        type => $_->{type},
                    };
                }
                else {
                    # This is the only place where new 'url' records are
                    # inserted.
                    $_->{id} = db_insert($db, 'url',
                        url => $url,
                        wc_id => $self->{wc_id},
                        guid_id => $self->{guid_id},
                        generator => $_->{generator},
                        method => $_->{method},
                        argument => $_->{argument},
                        content_type => $_->{type},
                        status => 'A',
                    );
                    $url_activated{$url} = $_;
                }
            }
        }
    }

    # Adjust any previously-active URLs which are no longer active.
    for (values %old_active) {
        if (defined $dup_urls && exists $dup_urls->{$_->{url}}) {
            # A new URL which is a duplicate of this one has been created
            # by a different file, and is waiting in the wings in the hopes
            # that this file will ditch it.  We can now replace the old one
            # with the new one from the other file, and thereby resolve
            # the duplication.
            my $dup = $dup_urls->{$_->{url}};
            assert($dup->{id} == $_->{id}) if DEBUG;
            db_update($db, url => $_->{id},
                guid_id => $dup->{guid_id},
                generator => $dup->{generator},
                method => $dup->{method},
                argument => $dup->{argument},
                content_type => $dup->{type},
            );

            delete $dup_urls->{$_->{url}};
            next;
        }

        if (!@new_url) {
            # Nothing to redirect to, so mark the old one as gone.
            db_update($db, url => $_->{id},
                status => 'G',
            );
            $self->_update_rewrite(\%gone_changed, 'gone', $_->{url});
            $url_deactivated{$_->{url}} = $_;
        }
        else {
            # Change it to a redirect, if there are any active URLs which
            # are suitable (same generator, method, and argument).  If there
            # are multiple choices, choose the one with the same content type,
            # or the first of any ties.
            my $best_match;
            for my $new (@new_url) {
                next unless $new->{generator} eq $_->{generator} &&
                            $new->{method} eq $_->{method} &&
                            $new->{argument} eq $_->{argument};

                $best_match = $new
                    unless defined $best_match;
                next unless $new->{type} eq $_->{content_type};

                $best_match = $new;
                last;
            }

            if (defined $best_match) {
                # Set old URL to redirect.
                # TODO - I don't think I'm being consistent about what the
                # content type of a redirect URL means.  Is it just a left-over
                # from the old inactive URL, or as here is it the type of
                # the target URL?
                assert(defined $best_match->{id}) if DEBUG;
                db_update($db, url => $_->{id},
                    content_type => $best_match->{type},
                    status => 'R',
                    redirect_to_id => $best_match->{id},
                );
                $self->_update_rewrite(\%redirects_changed, 'redirect',
                                       $_->{url});
                $url_changed{$best_match->{url}} = {
                    %$best_match,
                    old_url_info => $_,
                };
                delete $url_activated{$best_match->{url}};

                # Adjust any which previously redirected to the old URL
                # so that they point directly to the new one.
                db_update($db, url => { redirect_to_id => $_->{id} },
                    content_type => $best_match->{type},
                    redirect_to_id => $best_match->{id},
                );
            }
            else {
                # Kill the old URL.
                db_update($db, url => $_->{id},
                    status => 'G',
                );
                $self->_update_rewrite(\%gone_changed, 'gone', $_->{url});
                $url_deactivated{$_->{url}} = $_;
            }
        }
    }

    return {
        update_redirect_maps => \%redirects_changed,
        update_gone_maps => \%gone_changed,
        url_activated => \%url_activated,
        url_deactivated => \%url_deactivated,
        url_changed => \%url_changed,
    };
}

sub _update_rewrite
{
    my ($self, $which_changed, $map_name, $url) = @_;
    my ($config) = $self->{cms}->output_config($url);
    return unless defined $config;

    my $map_file = $config->{"${map_name}_map"};
    $which_changed->{$map_file} = $config
        if defined $map_file && !exists $which_changed->{$map_file};
}

1;
# vi:ts=4 sw=4 expandtab