view release on metacpan or  search on metacpan

lib/Daizu/File.pm  view on Meta::CPAN

sub short_title { shift->{short_title} }

=item $file-E<gt>description

Return the description/summary of C<$file>, as a decoded Perl text string,
or undef if the file doesn't have a description.  The value is taken from
the file's C<dc:description> property.

=cut

sub description { shift->{description} }

=item $file-E<gt>generator

Create and return a generator object for the file C<$file>.
Figures out which generator class to use,
by looking at the C<daizu:generator> property for the file, and if
necessary its ancestors.  The class is loaded automatically.
It also knows to use L<Daizu::Gen> if no generator specification is found.

Returns the new object, which should support the API of class L<Daizu::Gen>.

=cut

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;
}

=item $file-E<gt>update_loaded_article_in_db

Updates the cached article content for C<$file> in the database.
This includes the finished XML version of the content,
the article pages URL, the extra URLs, and the extra templates.
Does nothing if the file isn't an article.
Fails if it is but there are no plugins able to load it.

This normally happens automatically when a file's content is updated,
and can also be triggered manually from the C<daizu> program with
the 

This is where article loader plugins set with the L<Daizu> method
L<add_article_loader()|Daizu/$cms-E<gt>add_article_loader($mime_type, $path, $object, $method)>
are invoked.

Doesn't return anything.

=cut

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'";
}

lib/Daizu/File.pm  view on Meta::CPAN

    $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;
}

=item $file-E<gt>update_urls_in_db([$dup_urls])

Updates the C<url> table to match the current URLs generated by C<$file>,
as returned by the generator method
L<urls_info()|Daizu::Gen/$gen-E<gt>urls_info($file)>.
This includes changing active URLs to redirects or marking them 'gone'
if they are no longer generated by the file.

If this update isn't being done in isolation, but for example is being
run by the
L<update_all_file_urls()|Daizu::Util/update_all_file_urls($cms, $wc_id)>
function, then C<$dup_urls> should be a reference to a hash which can be
used to keep track of new URLs which cannot be added to the database yet
because they would conflict with an existing active URL.  This method will
remove them from the hash later if the original active URL becomes inactive,
and will replace it in the database with the new one.  Some cleanup code
is needed in the caller though to finish processing any URLs left in the
hash, or to signal errors if they are a genuine conflict which cannot be
resolved.  An error should cause the transaction to update, because items
in the hash represent unfinished updates to the database.

Returns a list of two values, which can each be either true or false.
They indicate whether the set of URLs which are redirects or marked as
'gone' have changed.  The first indicates that at least one redirect has
been added, removed, or had its destination changed.  The second value
indicates that a previously active or redirected URL is now marked 'gone',
or that a previously dead URL has been reactivated or turned into a redirect.
These two values can be used to determine whether redirect maps need to
be regenerated by the caller.

The work is done in a transaction, so that if it fails there will be
no changes to the database.

TODO - update docs about return value

=cut

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},
            );