#!/usr/bin/perl
use warnings;
use strict;
use Test::More;
use Carp::Assert qw( assert );
use Daizu;
use Daizu::Test qw( init_tests );
use Daizu::Util qw( db_row_id update_all_file_urls );
init_tests(114);
my $cms = Daizu->new($Daizu::Test::TEST_CONFIG);
my $db = $cms->db;
my $wc = $cms->live_wc;
# Clean up in case we've already run this.
{
$db->do("delete from url");
$db->do("delete from working_copy where id = 3");
$db->do("select setval('working_copy_id_seq', 2)");
}
# $generator->base_url
test_base_url($wc, 'top-level', undef);
test_base_url($wc, 'foo.com', 'http://foo.com/');
test_base_url($wc, 'foo.com/_index.html', 'http://foo.com/');
test_base_url($wc, 'foo.com/_hide', undef);
test_base_url($wc, 'foo.com/_hide/readme.txt', undef);
test_base_url($wc, 'foo.com/blog', 'http://foo.com/blog/');
test_base_url($wc, 'example.com/fractal.png',
'http://www.example.com/fractal.png');
test_base_url($wc, 'foo.com/blog/2006/fish-fingers/article-1.html',
'http://foo.com/blog/2006/03/article-1/');
test_base_url($wc, 'foo.com/blog/2006/strawberries/article-4.html',
'http://foo.com/blog/custom/url');
test_base_url($wc, 'foo.com/blog/2006',
'http://foo.com/blog/2006/');
test_base_url($wc, 'foo.com/blog/2006/strawberries',
'http://foo.com/blog/2006/strawberries/');
test_base_url($wc, 'foo.com/blog/2006/strawberries/article-5',
'http://foo.com/blog/2006/06/article-5/');
test_base_url($wc, 'foo.com/blog/2006/strawberries/article-5/_index.html',
'http://foo.com/blog/2006/06/article-5/');
test_base_url($wc, 'foo.com/blog/2006/strawberries/article-5/extra1.txt',
'http://foo.com/blog/2006/06/article-5/extra1.txt');
test_base_url($wc, 'foo.com/blog/2006/strawberries/article-5/subdir',
'http://foo.com/blog/2006/06/article-5/subdir/');
test_base_url($wc, 'foo.com/blog/2006/strawberries/article-5/subdir/extra2.txt',
'http://foo.com/blog/2006/06/article-5/subdir/extra2.txt');
# Daizu::Gen->urls
my $file = $wc->file_at_path('example.com/dir');
my @url = $file->generator->urls_info($file);
is(scalar @url, 0, 'urls: Gen: random dir, no URLs');
$file = $wc->file_at_path('example.com');
@url = $file->generator->urls_info($file);
is(scalar @url, 0, 'urls: Gen: top-level dir, no URLs');
$file = $wc->file_at_path('foo.com');
@url = $file->generator->urls_info($file);
is(scalar @url, 1, 'urls: Gen: sitemap dir, one URL');
is($url[0]{url}, 'http://foo.com/sitemap.xml.gz',
'urls: Gen: sitemap dir, url');
is($url[0]{method}, 'xml_sitemap', 'urls: Gen: sitemap dir, method');
is($url[0]{argument}, '', 'urls: Gen: sitemap dir, argument');
is($url[0]{type}, 'application/xml', 'urls: Gen: sitemap dir, type');
is($url[0]{generator}, 'Daizu::Gen', 'urls: Gen: sitemap dir, generator');
$file = $wc->file_at_path('foo.com/doc/Util.pm');
@url = $file->generator->urls_info($file);
is(scalar @url, 2, 'urls: Gen: perl docs, extra URL for source code');
# the 'article pages' URLs always come first.
is($url[0]{url}, 'http://foo.com/doc/Util.html',
'urls: Gen: perl docs, HTML url');
is($url[0]{method}, 'article', 'urls: Gen: perl docs, HTML method');
is($url[0]{argument}, '', 'urls: Gen: perl docs, HTML argument');
is($url[0]{type}, 'text/html', 'urls: Gen: perl docs, HTML type');
is($url[0]{generator}, 'Daizu::Gen', 'urls: Gen: perl docs, HTML generator');
is($url[1]{url}, 'http://foo.com/doc/Util.pm',
'urls: Gen: perl docs, POD url');
is($url[1]{method}, 'unprocessed', 'urls: Gen: perl docs, POD method');
is($url[1]{argument}, '', 'urls: Gen: perl docs, POD argument');
is($url[1]{type}, 'text/x-perl', 'urls: Gen: perl docs, POD type');
is($url[1]{generator}, 'Daizu::Gen', 'urls: Gen: perl docs, POD generator');
$file = $wc->file_at_path('foo.com/blog');
@url = $file->generator->urls_info($file);
is(scalar @url, 10, 'urls: Gen::Blog: blog dir, right number of URLs');
is($url[0]{url}, 'http://foo.com/blog/',
'urls: Gen::Blog: blog dir, homepage, url');
is($url[0]{method}, 'homepage',
'urls: Gen::Blog: blog dir, homepage, method');
is($url[0]{argument}, '',
'urls: Gen::Blog: blog dir, homepage, argument');
is($url[0]{type}, 'text/html',
'urls: Gen::Blog: blog dir, homepage, type');
is($url[0]{generator}, 'Daizu::Gen::Blog',
'urls: Gen::Blog: blog dir, homepage, generator');
is($url[1]{url}, 'http://foo.com/blog/feed.atom',
'urls: Gen::Blog: blog dir, feed, url');
is($url[1]{method}, 'feed',
'urls: Gen::Blog: blog dir, feed, method');
is($url[1]{argument}, 'atom snippet 14',
'urls: Gen::Blog: blog dir, feed, argument');
is($url[1]{type}, 'application/atom+xml',
'urls: Gen::Blog: blog dir, feed, type');
is($url[1]{generator}, 'Daizu::Gen::Blog',
'urls: Gen::Blog: blog dir, feed, generator');
my %year_urls = (2 => 2003, 4 => 2005, 6 => 2006);
for (sort { $a <=> $b } keys %year_urls) {
my $year = $year_urls{$_};
is($url[$_]{url}, "http://foo.com/blog/$year/",
"urls: Gen::Blog: blog dir, $year, url");
is($url[$_]{method}, 'year_archive',
"urls: Gen::Blog: blog dir, $year, method");
is($url[$_]{argument}, $year,
"urls: Gen::Blog: blog dir, $year, argument");
is($url[$_]{type}, 'text/html',
"urls: Gen::Blog: blog dir, $year, type");
is($url[$_]{generator}, 'Daizu::Gen::Blog',
"urls: Gen::Blog: blog dir, $year, generator");
}
my %month_urls = (
3 => [ 2003, 1 ],
5 => [ 2005, 5 ],
7 => [ 2006, 3 ],
8 => [ 2006, 5 ],
9 => [ 2006, 6 ],
);
for (sort { $a <=> $b } keys %month_urls) {
my ($year, $month) = @{$month_urls{$_}};
is($url[$_]{url}, sprintf('http://foo.com/blog/%d/%02d/', $year, $month),
"urls: Gen::Blog: blog dir, $year/$month, url");
is($url[$_]{method}, 'month_archive',
"urls: Gen::Blog: blog dir, $year/$month, method");
is($url[$_]{argument}, sprintf('%d %02d', $year, $month),
"urls: Gen::Blog: blog dir, $year/$month, argument");
is($url[$_]{type}, 'text/html',
"urls: Gen::Blog: blog dir, $year/$month, type");
is($url[$_]{generator}, 'Daizu::Gen::Blog',
"urls: Gen::Blog: blog dir, $year/$month, generator");
}
# PictureArticle URLs.
$file = $wc->file_at_path('foo.com/blog/2005/photos/wasp-on-holly-leaf.jpg');
@url = $file->generator->urls_info($file);
is(scalar @url, 3, 'urls: PictureArticle: number');
is($url[0]{url}, 'http://foo.com/blog/2005/05/wasp-on-holly-leaf/',
'urls: PictureArticle: page url');
is($url[0]{method}, 'article', 'urls: PictureArticle: page method');
is($url[0]{argument}, '', 'urls: PictureArticle: page argument');
is($url[0]{type}, 'text/html', 'urls: PictureArticle: page type');
is($url[0]{generator}, 'Daizu::Gen::Blog',
'urls: PictureArticle: page generator');
is($url[1]{url},
'http://foo.com/blog/2005/05/wasp-on-holly-leaf/wasp-on-holly-leaf.jpg',
'urls: PictureArticle: picture url');
is($url[1]{method}, 'unprocessed', 'urls: PictureArticle: picture method');
is($url[1]{argument}, '', 'urls: PictureArticle: picture argument');
is($url[1]{type}, 'image/jpeg', 'urls: PictureArticle: picture type');
is($url[1]{generator}, 'Daizu::Gen', 'urls: PictureArticle: picture generator');
is($url[2]{url},
'http://foo.com/blog/2005/05/wasp-on-holly-leaf/wasp-on-holly-leaf-thm.jpg',
'urls: PictureArticle: thumbnail url');
is($url[2]{method}, 'scaled_image', 'urls: PictureArticle: thumbnail method');
is($url[2]{argument}, '300 300', 'urls: PictureArticle: thumbnail argument');
is($url[2]{type}, 'image/jpeg', 'urls: PictureArticle: thumbnail type');
is($url[2]{generator}, 'Daizu::Gen',
'urls: PictureArticle: thumbnail generator');
# $file->permalink
is($wc->file_at_path('foo.com/blog/2006/fish-fingers/article-2.html')
->permalink,
'http://foo.com/blog/2006/03/article-2/',
'permalink: foo.com/blog/2006/fish-fingers/article-2.html');
is($wc->file_at_path('foo.com/doc/Util.pm')->permalink,
'http://foo.com/doc/Util.html',
'permalink: foo.com/doc/Util.pm');
is($wc->file_at_path('foo.com/blog/foo.txt')->permalink,
'http://foo.com/blog/foo.txt',
'permalink: foo.com/blog/foo.txt');
{
my @url = $wc->file_at_path('foo.com/_hide/readme.txt')->permalink;
is(scalar @url, 0, 'permalink: foo.com/_hide/readme.txt');
}
# Daizu::Util::update_all_file_urls
my $url_changes = update_all_file_urls($cms, $wc->id);
is(scalar keys %{$url_changes->{update_redirect_maps}}, 0,
'update_all_file_urls: no redirect changes');
is(scalar keys %{$url_changes->{update_gone_maps}}, 0,
'update_all_file_urls: no gone changes');
# Daizu::File->update_urls_in_db
my $url_wc = Daizu::Wc->checkout($cms, 'trunk', 43);
assert($url_wc->id == 3);
update_all_file_urls($cms, $url_wc->id);
my %dup;
$url_wc->update(44);
my $foo_bar_id = db_row_id($db, 'wc_file', wc_id => $url_wc->id, path => 'example.com/swap-urls/bar');
my $bar_foo_id = db_row_id($db, 'wc_file', wc_id => $url_wc->id, path => 'example.com/swap-urls/foo');
$url_changes = Daizu::File->new($cms, $foo_bar_id)->update_urls_in_db(\%dup);
is(scalar keys %{$url_changes->{url_activated}}, 0,
'update_urls_in_db: r44, foo-bar, none activated');
$url_changes = Daizu::File->new($cms, $bar_foo_id)->update_urls_in_db(\%dup);
is(scalar keys %{$url_changes->{url_activated}}, 1,
'update_urls_in_db: r44, bar-foo, one activated');
is((keys %{$url_changes->{url_activated}})[0],
'http://www.example.com/swap-urls/foo',
'update_urls_in_db: r44, bar-foo, foo activated');
is(scalar keys %{$url_changes->{update_redirect_maps}}, 1,
'update_urls_in_db: r44, only one');
like((keys %{$url_changes->{update_redirect_maps}})[0],
qr/example.com-redirect.map$/,
'update_urls_in_db: r44, right one');
is(scalar keys %dup, 0, 'update_urls_in_db: r44, no dups');
sub test_base_url
{
my ($wc, $path, $expected_url) = @_;
my $file = $wc->file_at_path($path);
assert($file);
my $gen = $file->generator;
assert($gen);
is($gen->base_url($file), $expected_url, "generator->base_url: $path");
}
# vi:ts=4 sw=4 expandtab filetype=perl