view release on metacpan or  search on metacpan

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

=cut

our $SITEMAP_NS = 'http://www.sitemaps.org/schemas/sitemap/0.9';

sub xml_sitemap
{
    my ($self, $file, $urls) = @_;
    my $db = $self->{cms}{db};

    for my $url (@$urls) {
        my $base_url = $self->base_url($file);
        die "error generating sitemap: file $file->{id} has no base URL"
            unless defined $base_url;

        my $doc = XML::LibXML::Document->new('1.0', 'UTF-8');
        my $sitemap = $doc->createElementNS($SITEMAP_NS, 'urlset');
        $doc->setDocumentElement($sitemap);

        my $sth = $db->prepare(qq{
            select u.url, f.modified_at, f.article
            from url u
            inner join wc_file f on u.wc_id = f.wc_id and u.guid_id = f.guid_id
            where f.wc_id = ?
              and u.status = 'A'
              and not f.no_index
              and u.content_type in
                  ('application/xhtml+xml', 'text/html', 'application/pdf')
              and u.url like ?
            order by u.url
        });
        $sth->execute($file->{wc_id}, like_escape($base_url) . '%');

        while (my ($url, $updated, $article) = $sth->fetchrow_array) {
            next if length($url) >= 2048;   # Google won't accept this

            $sitemap->appendText("\n");
            my $elem = add_xml_elem($sitemap, 'url');
            add_xml_elem($elem, loc => $url);
            $updated = parse_db_datetime($updated);
            add_xml_elem($elem, lastmod => w3c_datetime($updated))
                if defined $updated;
            add_xml_elem($elem, priority => ($article ? '1.0' : '0.5'));
        }

        my $gz = gzopen($url->{fh}, 'wb9')
            or die "error opening sitemap file: $gzerrno";
        $gz->gzwrite($doc->toStringC14N)
            or die 'error writing compressed sitemap file: ' . $gz->gzerror;
        $gz->gzclose
            and die 'error closing compressed sitemap file: ' . $gz->gzerror;
        $url->{fh} = undef;     # don't try to close it again later
    }
}


=item $gen-E<gt>scaled_image($file, $urls)

A standard generator method which generates a scaled version of an image
file.  C<$file> must represent an image in a format which can be understood
by L<Image::Magick>, unless the GUID ID value is included in the argument,
in which case there must be a file with that GUID ID in the working copy which
is of an appropriate type.

The argument should consist of two or three numbers: the desired width and
height of the resulting image, and optionally the GUID ID of the image file
if it isn't the file the URL is actually generated from.  These should be
separated by single spaces.

=cut

sub scaled_image
{
    my ($self, $file, $urls) = @_;

    for my $url (@$urls) {
        die "bad argument '$url->{argument}' for scaled_image URL"
            unless $url->{argument} =~ /^(\d+) (\d+)(?: (\d+))?$/;
        my ($width, $height, $img_guid_id) = ($1, $2, $3);

        my $img_file = $file;
        if (defined $img_guid_id) {
            my $img_file_id = db_row_id($self->{cms}{db}, 'wc_file',
                wc_id => $file->{wc_id},
                guid_id => $img_guid_id,
            );
            die "image file with GUID ID $img_guid_id not in working copy"
                unless defined $img_file_id;
            $img_file = Daizu::File->new($self->{cms}, $img_file_id);
        }
        my $data = $img_file->data;

        require Image::Magick;
        my $img = Image::Magick->new;
        $img->BlobToImage($$data);

        # Discard all but the first frame, in case it's an animated GIF,
        # otherwise we'll end up with multiple output files.
        $#$img = 0;

        $img->Thumbnail(width => $width, height => $height);

        # TODO: This atrocity is only temporary, until I work out how to
        # tell ImageMagick to write to a bloody file handle.  What the
        # documentation says doesn't work, it just goes to STDOUT.
        my ($tmp_fh, $tmp_filename) = tempfile();
        $img->Write($tmp_filename);

        seek $tmp_fh, 0, 0 or die "error seeking: $!";
        binmode $tmp_fh or die "error binmoding: $!";
        my $out_fh = $url->{fh};
        while (<$tmp_fh>) {
            print $out_fh $_;
        }

        close $tmp_fh;
        unlink $tmp_filename
            or warn "error removing temporary file '$tmp_filename': $!";
    }
}

=item $gen-E<gt>navigation_menu($file, $url)

Return a recursive data structure describing a suitable menu for displaying
on a page associated with C<$file>, which must be a L<Daizu::File> object.
C<$url> is the URL info for the page being generated.

This is called from the default I<nav_menu.tt> template to generate the
menu to put in the right-hand column.

The menu will not include the homepage (because that is presumably already
linked from the top of the page or something, and it would be a waste of
an extra level in the menu), and will not include any 'retired' articles.

The return value is a reference to an array of zero or more hashes,
each of which will contain the following keys:

=over

=item link

The URL of the page the menu item refers to, relative to C<$url>.  That is,
this may not be an absolute URL, but it should get you to the right place
from the page this menu was intended for.

This value will not be present for a menu item which refers to the current
URL, because that shouldn't be a link (it's bad usability practice to link
to the current page, because people might wonder why nothing happened).

=item title

The full title of the page the item refers to, if any.

=item short_title