| 1 | use strict; |
|---|
| 2 | use lib 't/lib', 'extlib', 'lib', '../lib', '../extlib'; |
|---|
| 3 | use POSIX; |
|---|
| 4 | |
|---|
| 5 | use MT; |
|---|
| 6 | use MT::Atom; |
|---|
| 7 | use XML::LibXML; # this test would not work without it |
|---|
| 8 | use XML::XPath; |
|---|
| 9 | use XML::Atom; |
|---|
| 10 | use XML::Atom::Feed; |
|---|
| 11 | use XML::Atom::Entry; |
|---|
| 12 | use POSIX qw( ceil ); |
|---|
| 13 | |
|---|
| 14 | use Test::More qw( no_plan );#tests => 97; |
|---|
| 15 | |
|---|
| 16 | # To keep away from being under FastCGI |
|---|
| 17 | $ENV{HTTP_HOST} = 'localhost'; |
|---|
| 18 | |
|---|
| 19 | use vars qw( $DB_DIR $T_CFG ); |
|---|
| 20 | my $mt = MT->new( Config => $T_CFG ) or die MT->errstr; |
|---|
| 21 | isa_ok($mt, 'MT'); |
|---|
| 22 | |
|---|
| 23 | use MT::Test qw(:db :data); |
|---|
| 24 | |
|---|
| 25 | my %test_data; |
|---|
| 26 | $test_data{'/mt-atom.cgi/weblog'} = <<XML1; |
|---|
| 27 | <?xml version="1.0" encoding="utf-8"?> |
|---|
| 28 | <entry xmlns="http://purl.org/atom/ns#" xmlns:dc="http://purl.org/dc/elements/1.1/"> |
|---|
| 29 | <title>Fight the Power</title> |
|---|
| 30 | <content>Elvis was a hero to most but he never meant shit to me</content> |
|---|
| 31 | <issued>2004-08-06T00:43:34+01:00</issued> |
|---|
| 32 | </entry> |
|---|
| 33 | XML1 |
|---|
| 34 | $test_data{'/mt-atom.cgi/1.0'} = <<XML2; |
|---|
| 35 | <?xml version="1.0" encoding="utf-8"?> |
|---|
| 36 | <entry xmlns="http://www.w3.org/2005/Atom"> |
|---|
| 37 | <title>Fight the Power</title> |
|---|
| 38 | <content type="html">Elvis was a hero to most but he never meant shit to me</content> |
|---|
| 39 | <published>2004-08-06T00:43:34+01:00</published> |
|---|
| 40 | </entry> |
|---|
| 41 | XML2 |
|---|
| 42 | |
|---|
| 43 | my %feed_link = ( |
|---|
| 44 | '/mt-atom.cgi/weblog' => sub { |
|---|
| 45 | my ($resp) = @_; |
|---|
| 46 | my $feed = XML::Atom::Feed->new(\$resp->content()); |
|---|
| 47 | ok($feed, 'got feed'); |
|---|
| 48 | my ($sfeed) = grep { |
|---|
| 49 | $_->rel eq 'service.feed' |
|---|
| 50 | } $feed->links; |
|---|
| 51 | $sfeed->href; |
|---|
| 52 | }, |
|---|
| 53 | '/mt-atom.cgi/1.0' => sub { |
|---|
| 54 | my ($resp) = @_; |
|---|
| 55 | my $feed = XML::XPath->new(xml => $resp->content()); |
|---|
| 56 | ok($feed, 'got feed'); |
|---|
| 57 | my $col = $feed->getNodeText('/service/workspace[1]/collection/@href'); |
|---|
| 58 | $col; |
|---|
| 59 | } |
|---|
| 60 | ); |
|---|
| 61 | |
|---|
| 62 | my $username = 'Chuck D'; |
|---|
| 63 | my $chuck = MT::Author->load({name => $username}) |
|---|
| 64 | or die "Couldn't load $username"; |
|---|
| 65 | my $chuck_token = $chuck->api_password; |
|---|
| 66 | |
|---|
| 67 | # not a good nonce-maker |
|---|
| 68 | my @hexch = ('0' .. '9', 'a' .. 'f'); |
|---|
| 69 | sub make_nonce { |
|---|
| 70 | join '', map { $hexch[rand() * @hexch] } (0..7); |
|---|
| 71 | } |
|---|
| 72 | sub make_wsse { |
|---|
| 73 | my ($password) = @_; |
|---|
| 74 | my $timestamp = strftime("%Y-%m-%dT%H:%M:%SZ", gmtime(time)); |
|---|
| 75 | my $nonce = make_nonce(); |
|---|
| 76 | my $PasswordDigest = sha1_base64($nonce . $timestamp . $chuck_token); |
|---|
| 77 | # print "# PasswordDigest is sha1('$nonce$timestamp$chuck_token')\n"; |
|---|
| 78 | $nonce = MIME::Base64::encode_base64($nonce, ''); |
|---|
| 79 | return "UserNameToken Username=\"$username\", " |
|---|
| 80 | . "PasswordDigest=\"$PasswordDigest\", Nonce=\"$nonce\", " |
|---|
| 81 | . "Created=\"$timestamp\""; |
|---|
| 82 | } |
|---|
| 83 | |
|---|
| 84 | require LWP::UserAgent::Local; |
|---|
| 85 | my $ua = new LWP::UserAgent::Local({ ScriptAlias => '/' }); |
|---|
| 86 | |
|---|
| 87 | foreach my $base_uri ( qw{/mt-atom.cgi/weblog /mt-atom.cgi/1.0 } ) { |
|---|
| 88 | { |
|---|
| 89 | # # # # First try a req with baloney auth, make sure it fails |
|---|
| 90 | # TBD: Try more bogus auth varieties |
|---|
| 91 | my $nonce = make_nonce(); |
|---|
| 92 | $nonce = MIME::Base64::encode_base64($nonce, ''); |
|---|
| 93 | |
|---|
| 94 | my $uri = new URI(); |
|---|
| 95 | $uri->path($base_uri . '/blog_id=1'); |
|---|
| 96 | my $req = new HTTP::Request(GET => $uri); |
|---|
| 97 | $req->header(Authentication => 'Atom'); |
|---|
| 98 | $req->header('X-WSSE' => "UserNameToken Username=\"Melody\", PasswordDigest=\"Oj12fART+XZvBZBe39vVvkirg4w\", Nonce=\"" . $nonce . "\", Created=\"2004-05-19T20:08:57Z\""); |
|---|
| 99 | print "# requesting: " . $req->uri . "\n"; |
|---|
| 100 | my $resp = $ua->request($req); |
|---|
| 101 | |
|---|
| 102 | print "# response code was: " . $resp->code . "\n"; |
|---|
| 103 | print "# content was: " . $resp->content . "\n";# if !$resp->code(); |
|---|
| 104 | ok($resp->is_error()); |
|---|
| 105 | } |
|---|
| 106 | |
|---|
| 107 | # test blog lists |
|---|
| 108 | { |
|---|
| 109 | my $wsse_header = make_wsse($chuck_token); |
|---|
| 110 | my $uri = new URI; |
|---|
| 111 | $uri->path($base_uri); |
|---|
| 112 | my $req = new HTTP::Request(GET => $uri); |
|---|
| 113 | $req->header('Authorization' => 'Atom'); |
|---|
| 114 | $req->header('X-WSSE' => $wsse_header); |
|---|
| 115 | |
|---|
| 116 | print "# X-WSSE: $wsse_header\n"; |
|---|
| 117 | |
|---|
| 118 | my $resp = $ua->request($req); |
|---|
| 119 | if (ok($resp->is_success)) { |
|---|
| 120 | my $blog_feed_url = $feed_link{$base_uri}->($resp); |
|---|
| 121 | my $blog_feed_uri = new URI($blog_feed_url); |
|---|
| 122 | is($blog_feed_uri->path, $base_uri . '/blog_id=1', 'blog feed url is correct'); |
|---|
| 123 | } |
|---|
| 124 | else { |
|---|
| 125 | die 'failed to retrieve blog feed'; |
|---|
| 126 | } |
|---|
| 127 | } |
|---|
| 128 | |
|---|
| 129 | # test blog feed |
|---|
| 130 | { |
|---|
| 131 | my $wsse_header = make_wsse($chuck_token); |
|---|
| 132 | my $uri = new URI; |
|---|
| 133 | $uri->path($base_uri . "/blog_id=1"); |
|---|
| 134 | my $req = new HTTP::Request(GET => $uri); |
|---|
| 135 | $req->header('Authorization' => 'Atom'); |
|---|
| 136 | $req->header('X-WSSE' => $wsse_header); |
|---|
| 137 | |
|---|
| 138 | print "# X-WSSE: $wsse_header\n"; |
|---|
| 139 | |
|---|
| 140 | my $resp = $ua->request($req); |
|---|
| 141 | if (ok($resp->is_success)) { |
|---|
| 142 | my $feed = XML::Atom::Feed->new(\$resp->content()); |
|---|
| 143 | ok($feed, 'got feed'); |
|---|
| 144 | is($feed->title, 'none'); |
|---|
| 145 | my ($alternate) = grep { |
|---|
| 146 | $_->rel eq 'alternate' && $_->type eq 'text/html' |
|---|
| 147 | } $feed->links; |
|---|
| 148 | is($alternate->href, 'http://narnia.na/nana/', 'blog url is correct'); |
|---|
| 149 | my $entry_count = MT::Entry->count( |
|---|
| 150 | { blog_id => 1 }, |
|---|
| 151 | { limit => 21 }, |
|---|
| 152 | ); |
|---|
| 153 | my @entries = $feed->entries; |
|---|
| 154 | is($entry_count, scalar(@entries), 'number of entries is correct'); |
|---|
| 155 | |
|---|
| 156 | # check if entries have replies link relation |
|---|
| 157 | my $failed = 0; |
|---|
| 158 | foreach my $entry (@entries) { |
|---|
| 159 | next if !$entry->id && $entry->title =~ /^I just finished installing Movable Type/; |
|---|
| 160 | my $mt_entry = MT::Entry->load({ |
|---|
| 161 | atom_id => $entry->id, |
|---|
| 162 | blog_id => 1, |
|---|
| 163 | }); |
|---|
| 164 | $failed = 1, last unless $mt_entry; |
|---|
| 165 | my ($replies) = grep { |
|---|
| 166 | $_->rel eq 'replies' |
|---|
| 167 | } $entry->links; |
|---|
| 168 | $failed = 2, last unless $replies; |
|---|
| 169 | my $replies_uri = new URI($replies->href); |
|---|
| 170 | my $cmt_url = '/mt-atom.cgi/comments/blog_id=1/entry_id='.$mt_entry->id; |
|---|
| 171 | $failed = 3, last unless $replies_uri->path =~ m|${cmt_url}$|; |
|---|
| 172 | } |
|---|
| 173 | is($failed, 0, 'all the entries have replies link rel'); |
|---|
| 174 | } |
|---|
| 175 | else { |
|---|
| 176 | die 'failed to retrieve blog feed'; |
|---|
| 177 | } |
|---|
| 178 | } |
|---|
| 179 | |
|---|
| 180 | my $entry_id; |
|---|
| 181 | |
|---|
| 182 | use constant USE_DIGEST => 0; |
|---|
| 183 | |
|---|
| 184 | if (USE_DIGEST) |
|---|
| 185 | { |
|---|
| 186 | # # # # # # # use this to do a Digest auth with MD5 as the algorithm. |
|---|
| 187 | my $realm = 'movabletype'; |
|---|
| 188 | # $username = shift; |
|---|
| 189 | # $hashed_pwd = shift; |
|---|
| 190 | require Digest::MD5; |
|---|
| 191 | my $hashed_pwd = Digest::MD5::md5(join ':', $username, $realm, $chuck_token); |
|---|
| 192 | my $method = 'POST'; |
|---|
| 193 | |
|---|
| 194 | my $uri = new URI; |
|---|
| 195 | $uri->path($base_uri . '/blog_id=1'); |
|---|
| 196 | my $req = new HTTP::Request(POST => $uri); |
|---|
| 197 | |
|---|
| 198 | my $resp = $ua->simple_request($req); |
|---|
| 199 | ok($resp->is_error()); |
|---|
| 200 | my $auth_header = $resp->header('WWW-Authenticate'); |
|---|
| 201 | my ($nonce) = $auth_header =~ /nonce=(\S*)/; |
|---|
| 202 | |
|---|
| 203 | my $A1 = pack('H*', $hashed_pwd); |
|---|
| 204 | my $A2 = $method . ':' . $uri; |
|---|
| 205 | |
|---|
| 206 | require Digest::MD5; |
|---|
| 207 | my $hash = \&Digest::MD5::md5; |
|---|
| 208 | my $kd = sub { $hash->($_[0].':'.$_[1]) }; |
|---|
| 209 | |
|---|
| 210 | print STDERR "Signing ", join(':', |
|---|
| 211 | $nonce, |
|---|
| 212 | '', |
|---|
| 213 | '', |
|---|
| 214 | 'auth', |
|---|
| 215 | $hash->($A2)), "\n"; |
|---|
| 216 | print STDERR "with key ", $hash->($A1), "\n"; |
|---|
| 217 | |
|---|
| 218 | my $response = $kd->($hash->($A1), join(':', |
|---|
| 219 | $nonce, |
|---|
| 220 | '', |
|---|
| 221 | '', |
|---|
| 222 | 'auth', |
|---|
| 223 | $hash->($A2))); |
|---|
| 224 | print "# ", ($response = unpack('H*', $response)), "\n"; |
|---|
| 225 | |
|---|
| 226 | $uri = new URI; |
|---|
| 227 | $uri->path($base_uri . '/blog_id=1'); |
|---|
| 228 | $req = new HTTP::Request(POST => $uri); |
|---|
| 229 | |
|---|
| 230 | $req->header('X-Atom-Authorization', "Digest nonce=$nonce, username=$username, realm=movabletype, uri=$uri, qop=auth, response=$response"); |
|---|
| 231 | print "# sending: ", $req->header('X-Atom-Authorization'); |
|---|
| 232 | |
|---|
| 233 | $req->content($test_data{$base_uri}); |
|---|
| 234 | |
|---|
| 235 | $resp = $ua->simple_request($req); |
|---|
| 236 | |
|---|
| 237 | print "# " . $resp->code . " " . $resp->message . "\n"; |
|---|
| 238 | print "# " . $resp->content . "\n"; |
|---|
| 239 | ok($resp->is_success()); |
|---|
| 240 | |
|---|
| 241 | print "##\n". $resp->header('Location') . "\n##\n"; |
|---|
| 242 | my $location = $resp->header('Location') |
|---|
| 243 | || die "No Location: header. Did get\n" |
|---|
| 244 | . $resp->code() . $resp->message() . "\n" |
|---|
| 245 | . $resp->headers_as_string() . "\n" |
|---|
| 246 | . $resp->content(); |
|---|
| 247 | ($entry_id) = ($location =~ /entry_id=(\d+)/); |
|---|
| 248 | |
|---|
| 249 | $entry_id || die "Couldn't get entry ID from header Location: " |
|---|
| 250 | . $location; |
|---|
| 251 | |
|---|
| 252 | print "# entry ID is $entry_id\n"; |
|---|
| 253 | |
|---|
| 254 | ok($entry_id); |
|---|
| 255 | } |
|---|
| 256 | |
|---|
| 257 | unless (USE_DIGEST) |
|---|
| 258 | { |
|---|
| 259 | print "# Doing Digest auth\n"; |
|---|
| 260 | # # # # Now try posting an entry with authentication |
|---|
| 261 | my $nonce = make_nonce(); |
|---|
| 262 | my $timestamp = strftime("%Y-%m-%dT%H:%M:%SZ", gmtime(time)); |
|---|
| 263 | use Digest::SHA1 qw(sha1_base64); |
|---|
| 264 | my $PasswordDigest = sha1_base64($nonce . $timestamp . $chuck_token); |
|---|
| 265 | |
|---|
| 266 | # print STDERR ("Client hashing (", |
|---|
| 267 | # unpack('H*', $nonce . $timestamp . $chuck_token), ")\n"); |
|---|
| 268 | # print STDERR " produces: $PasswordDigest\n"; |
|---|
| 269 | |
|---|
| 270 | $nonce = MIME::Base64::encode_base64($nonce, ''); |
|---|
| 271 | |
|---|
| 272 | print "# nonce: $nonce\n"; |
|---|
| 273 | |
|---|
| 274 | my $dir = `pwd`; chomp $dir; |
|---|
| 275 | while (! -x ($dir . "/mt-atom.cgi")) { |
|---|
| 276 | $dir =~ s!(/[^/]*)$!!; |
|---|
| 277 | last if $dir =~ m!^/?$!; |
|---|
| 278 | } |
|---|
| 279 | |
|---|
| 280 | my $uri = new URI; |
|---|
| 281 | $uri->path($base_uri . '/blog_id=1'); |
|---|
| 282 | my $req = new HTTP::Request(POST => $uri); |
|---|
| 283 | $req->header('Authorization' => 'Atom'); |
|---|
| 284 | $req->header('X-WSSE' => "UserNameToken Username=\"$username\", " |
|---|
| 285 | . "PasswordDigest=\"$PasswordDigest\", Nonce=\"$nonce\", " |
|---|
| 286 | . "Created=\"$timestamp\""); |
|---|
| 287 | |
|---|
| 288 | $req->content($test_data{$base_uri}); |
|---|
| 289 | |
|---|
| 290 | my $resp = $ua->simple_request($req); |
|---|
| 291 | |
|---|
| 292 | print "######### RESPONSE #########\n"; |
|---|
| 293 | print "# " . $resp->code . " " . $resp->message . "\n"; |
|---|
| 294 | my $content = $resp->content; |
|---|
| 295 | $content =~ s/^/# /gm; |
|---|
| 296 | print $content; |
|---|
| 297 | print "#########~RESPONSE #########\n"; |
|---|
| 298 | ok($resp->is_success()); |
|---|
| 299 | |
|---|
| 300 | #print "##\n". $resp->header('Location') . "\n##\n"; |
|---|
| 301 | my $location = $resp->header('Location') |
|---|
| 302 | || die "No Location: header. Did get\n" |
|---|
| 303 | . $resp->headers_as_string() . "\n" |
|---|
| 304 | . $resp->content(); |
|---|
| 305 | ($entry_id) = ($location =~ /entry_id=(\d+)/); |
|---|
| 306 | |
|---|
| 307 | $entry_id || die "Couldn't get entry ID from header Location: " |
|---|
| 308 | . $location; |
|---|
| 309 | |
|---|
| 310 | print "# entry ID is $entry_id\n"; |
|---|
| 311 | |
|---|
| 312 | ok($entry_id); |
|---|
| 313 | my $atom_obj = XML::Atom::Entry->new(\$resp->content()); |
|---|
| 314 | require Date::Parse; |
|---|
| 315 | print "# ", $atom_obj->issued(), "\n"; |
|---|
| 316 | is(Date::Parse::str2time($atom_obj->issued()), |
|---|
| 317 | Date::Parse::str2time('2004-08-06T00:43:34+01:00'), $atom_obj->issued()); |
|---|
| 318 | } |
|---|
| 319 | |
|---|
| 320 | { |
|---|
| 321 | my $wsse_header = make_wsse($chuck_token); |
|---|
| 322 | my $uri = new URI; |
|---|
| 323 | $uri->path($base_uri . "/blog_id=1/entry_id=$entry_id"); |
|---|
| 324 | my $req = new HTTP::Request(GET => $uri); |
|---|
| 325 | $req->header('Authorization' => 'Atom'); |
|---|
| 326 | $req->header('X-WSSE' => $wsse_header); |
|---|
| 327 | |
|---|
| 328 | print "# X-WSSE: $wsse_header\n"; |
|---|
| 329 | |
|---|
| 330 | my $resp = $ua->request($req); |
|---|
| 331 | |
|---|
| 332 | my $atom_entry = XML::Atom::Entry->new(Stream => \$resp->content()); |
|---|
| 333 | |
|---|
| 334 | is($atom_entry->title(), "Fight the Power"); |
|---|
| 335 | is($atom_entry->author()->name(), $chuck->nickname); |
|---|
| 336 | is($atom_entry->content()->body(), |
|---|
| 337 | "Elvis was a hero to most but he never meant shit to me"); |
|---|
| 338 | |
|---|
| 339 | $wsse_header = make_wsse($chuck_token); |
|---|
| 340 | $uri = new URI; |
|---|
| 341 | $uri->path($base_uri . "/blog_id=1/entry_id=$entry_id"); |
|---|
| 342 | $req = new HTTP::Request(PUT => $uri); |
|---|
| 343 | $req->header('Authorization' => 'Atom'); |
|---|
| 344 | $req->header('X-WSSE' => $wsse_header); |
|---|
| 345 | my $body = $atom_entry->as_xml(); |
|---|
| 346 | $req->content($body); |
|---|
| 347 | |
|---|
| 348 | $resp = $ua->request($req); |
|---|
| 349 | |
|---|
| 350 | if (ok($resp->is_success)) { |
|---|
| 351 | $atom_entry = XML::Atom::Entry->new(Stream => \$resp->content()); |
|---|
| 352 | is($atom_entry->title, "Fight the Power"); |
|---|
| 353 | is(Date::Parse::str2time($atom_entry->issued), |
|---|
| 354 | Date::Parse::str2time("2004-08-05T21:13:34-0230")); |
|---|
| 355 | } else { |
|---|
| 356 | print STDERR "# PUT request returned ", $resp->status_line(), "\n"; |
|---|
| 357 | skip(1); |
|---|
| 358 | skip(1); |
|---|
| 359 | } |
|---|
| 360 | } |
|---|
| 361 | |
|---|
| 362 | } #end foreach |
|---|
| 363 | |
|---|
| 364 | COMMENT: |
|---|
| 365 | # comments retrieval |
|---|
| 366 | { |
|---|
| 367 | my $wsse_header = make_wsse($chuck_token); |
|---|
| 368 | my $uri = new URI; |
|---|
| 369 | $uri->path('/mt-atom.cgi/comments/blog_id=1'); |
|---|
| 370 | my $req = new HTTP::Request(GET => $uri); |
|---|
| 371 | $req->header('Authorization' => 'Atom'); |
|---|
| 372 | $req->header('X-WSSE' => $wsse_header); |
|---|
| 373 | |
|---|
| 374 | my $resp = $ua->request($req); |
|---|
| 375 | if (ok($resp->is_success)) { |
|---|
| 376 | my $thr_ns = XML::Atom::Namespace->new(prefix => undef, uri => 'http://purl.org/syndication/thread/1.0'); |
|---|
| 377 | my $comments = XML::Atom::Feed->new(\$resp->content()); |
|---|
| 378 | my $count = MT::Comment->count({ |
|---|
| 379 | blog_id => 1, visible => 1 |
|---|
| 380 | }); |
|---|
| 381 | is( $count, scalar($comments->entries), 'comment count' ); |
|---|
| 382 | foreach my $c ( $comments->entries ) { |
|---|
| 383 | my $id = $c->id; |
|---|
| 384 | my ( $cmt_id ) = $id =~ m{/([0-9]+)$}; |
|---|
| 385 | die unless $cmt_id; |
|---|
| 386 | my $mt_comment = MT::Comment->load($cmt_id); |
|---|
| 387 | die unless $mt_comment; |
|---|
| 388 | my $mt_entry = $mt_comment->entry; |
|---|
| 389 | is($c->title, $mt_entry->title, 'comment title == entry title'); |
|---|
| 390 | is( $c->author->name, $mt_comment->author, 'comment author' ); |
|---|
| 391 | is( $c->author->email || '', $mt_comment->email || '', 'commenter email' ); |
|---|
| 392 | is( $c->author->uri || '', $mt_comment->url || '', 'commenter url' ); |
|---|
| 393 | if ( $XML::Atom::LIBXML ) { |
|---|
| 394 | my $nodelist = $c->elem->getElementsByTagNameNS('http://purl.org/syndication/thread/1.0', 'in-reply-to'); |
|---|
| 395 | my $irt = $nodelist->shift; |
|---|
| 396 | ok($irt, 'in-reply-to'); |
|---|
| 397 | is( $irt->ref, $mt_entry->atom_id, 'in-reply-to/ref' ); |
|---|
| 398 | is( $irt->href, $mt_entry->permalink, 'in-reply-to/href' ); |
|---|
| 399 | } |
|---|
| 400 | } |
|---|
| 401 | } |
|---|
| 402 | else { |
|---|
| 403 | die $resp->content(); |
|---|
| 404 | } |
|---|
| 405 | } |
|---|
| 406 | |
|---|
| 407 | { |
|---|
| 408 | my $iter = MT::Comment->count_group_by( |
|---|
| 409 | { blog_id => 1, visible => 1 }, |
|---|
| 410 | { group => ['entry_id'], sort => [ { desc => 'DESC', column => '1' } ] |
|---|
| 411 | } |
|---|
| 412 | ); |
|---|
| 413 | #$Data::ObjectDriver::PROFILE = 1; |
|---|
| 414 | #my $p = Data::ObjectDriver->profiler; |
|---|
| 415 | #$p->reset; |
|---|
| 416 | #print "$_\n" foreach @{$p->query_log}; |
|---|
| 417 | my ( $count, $eid ) = $iter->(); |
|---|
| 418 | # finish iterator cleanly |
|---|
| 419 | while ( my @dump = $iter->() ) {} |
|---|
| 420 | |
|---|
| 421 | my $entry = MT::Entry->load($eid); |
|---|
| 422 | |
|---|
| 423 | my $wsse_header = make_wsse($chuck_token); |
|---|
| 424 | my $uri = new URI; |
|---|
| 425 | $uri->path('/mt-atom.cgi/1.0/blog_id=1/entry_id=' . $entry->id); |
|---|
| 426 | my $req = new HTTP::Request(GET => $uri); |
|---|
| 427 | $req->header('Authorization' => 'Atom'); |
|---|
| 428 | $req->header('X-WSSE' => $wsse_header); |
|---|
| 429 | |
|---|
| 430 | my $resp = $ua->request($req); |
|---|
| 431 | if (ok($resp->is_success)) { |
|---|
| 432 | my $feed = XML::Atom::Entry->new(\$resp->content()); |
|---|
| 433 | my ($replies) = grep { |
|---|
| 434 | $_->rel eq 'replies' |
|---|
| 435 | } $feed->links; |
|---|
| 436 | |
|---|
| 437 | # retrieve comments from replies url |
|---|
| 438 | my $replies_uri = new URI($replies->href); |
|---|
| 439 | my $wsse_header = make_wsse($chuck_token); |
|---|
| 440 | my $uri = new URI; |
|---|
| 441 | $uri->path($replies_uri->path); |
|---|
| 442 | my $req = new HTTP::Request(GET => $uri); |
|---|
| 443 | $req->header('Authorization' => 'Atom'); |
|---|
| 444 | $req->header('X-WSSE' => $wsse_header); |
|---|
| 445 | |
|---|
| 446 | my $resp = $ua->request($req); |
|---|
| 447 | my $thr_ns = XML::Atom::Namespace->new(prefix => undef, uri => 'http://purl.org/syndication/thread/1.0'); |
|---|
| 448 | if (ok($resp->is_success)) { |
|---|
| 449 | my $comments = XML::Atom::Feed->new(\$resp->content()); |
|---|
| 450 | is( $count, scalar($comments->entries), 'comment count' ); |
|---|
| 451 | foreach my $e ( $comments->entries ) { |
|---|
| 452 | is($e->title, $entry->title, 'comment title == entry title'); |
|---|
| 453 | my $id = $e->id; |
|---|
| 454 | my ( $cmt_id ) = $id =~ m{/([0-9]+)$}; |
|---|
| 455 | die unless $cmt_id; |
|---|
| 456 | my $mt_comment = MT::Comment->load($cmt_id); |
|---|
| 457 | die unless $mt_comment; |
|---|
| 458 | is( $e->author->name, $mt_comment->author, 'comment author' ); |
|---|
| 459 | is( $e->author->email || '', $mt_comment->email || '', 'commenter email' ); |
|---|
| 460 | is( $e->author->uri || '', $mt_comment->url || '', 'commenter url' ); |
|---|
| 461 | if ( $XML::Atom::LIBXML ) { |
|---|
| 462 | my $nodelist = $e->elem->getElementsByTagNameNS('http://purl.org/syndication/thread/1.0', 'in-reply-to'); |
|---|
| 463 | my $irt = $nodelist->shift; |
|---|
| 464 | ok($irt, 'in-reply-to'); |
|---|
| 465 | is( $irt->ref, $entry->atom_id, 'in-reply-to/ref' ); |
|---|
| 466 | is( $irt->href, $entry->permalink, 'in-reply-to/href' ); |
|---|
| 467 | } |
|---|
| 468 | } |
|---|
| 469 | } |
|---|
| 470 | else { |
|---|
| 471 | die $resp->content(); |
|---|
| 472 | } |
|---|
| 473 | } |
|---|
| 474 | } |
|---|
| 475 | |
|---|
| 476 | { |
|---|
| 477 | my $thr_ns = XML::Atom::Namespace->new(prefix => undef, uri => 'http://purl.org/syndication/thread/1.0'); |
|---|
| 478 | my $wsse_header = make_wsse($chuck_token); |
|---|
| 479 | my $uri = new URI; |
|---|
| 480 | $uri->path('/mt-atom.cgi/comments/blog_id=1/comment_id=1'); |
|---|
| 481 | my $req = new HTTP::Request(GET => $uri); |
|---|
| 482 | $req->header('Authorization' => 'Atom'); |
|---|
| 483 | $req->header('X-WSSE' => $wsse_header); |
|---|
| 484 | |
|---|
| 485 | my $resp = $ua->request($req); |
|---|
| 486 | if (ok($resp->is_success)) { |
|---|
| 487 | my $c = XML::Atom::Entry->new(\$resp->content()); |
|---|
| 488 | my $mt_comment = MT::Comment->load(1); |
|---|
| 489 | die unless $mt_comment; |
|---|
| 490 | my $entry = $mt_comment->entry; |
|---|
| 491 | is( $c->title, $entry->title, 'comment title == entry title' ); |
|---|
| 492 | is( $c->author->name, $mt_comment->author, 'comment author' ); |
|---|
| 493 | is( $c->author->email || '', $mt_comment->email || '', 'commenter email' ); |
|---|
| 494 | is( $c->author->uri || '', $mt_comment->url || '', 'commenter url' ); |
|---|
| 495 | if ( $XML::Atom::LIBXML ) { |
|---|
| 496 | my $nodelist = $c->elem->getElementsByTagNameNS('http://purl.org/syndication/thread/1.0', 'in-reply-to'); |
|---|
| 497 | my $irt = $nodelist->shift; |
|---|
| 498 | ok($irt, 'in-reply-to'); |
|---|
| 499 | is( $irt->ref, $entry->atom_id, 'in-reply-to/ref' ); |
|---|
| 500 | is( $irt->href, $entry->permalink, 'in-reply-to/href' ); |
|---|
| 501 | } |
|---|
| 502 | } |
|---|
| 503 | else { |
|---|
| 504 | die $resp->content(); |
|---|
| 505 | } |
|---|
| 506 | } |
|---|
| 507 | |
|---|
| 508 | sub _test_limit_offset { |
|---|
| 509 | my ( $uri, $url, $limit, $total, $desc ) = @_; |
|---|
| 510 | my %items; |
|---|
| 511 | for ( my $i = 0; $i < ceil($total/$limit); $i++ ) { |
|---|
| 512 | my $wsse_header = make_wsse($chuck_token); |
|---|
| 513 | my $req = new HTTP::Request(GET => $uri); |
|---|
| 514 | $req->header('Authorization' => 'Atom'); |
|---|
| 515 | $req->header('X-WSSE' => $wsse_header); |
|---|
| 516 | |
|---|
| 517 | my $resp = $ua->request($req); |
|---|
| 518 | if (ok($resp->is_success)) { |
|---|
| 519 | my $thr_ns = XML::Atom::Namespace->new(prefix => undef, uri => 'http://purl.org/syndication/thread/1.0'); |
|---|
| 520 | my $items = XML::Atom::Feed->new(\$resp->content()); |
|---|
| 521 | ok ($items, 'items retrieved'); |
|---|
| 522 | if ( $total >= $limit * ($i+1) ) { |
|---|
| 523 | is( scalar($items->entries), $limit, 'limit applied ' . $desc ); |
|---|
| 524 | } |
|---|
| 525 | else { |
|---|
| 526 | ok( scalar($items->entries) < $limit, 'limit applied ' . $desc ); |
|---|
| 527 | } |
|---|
| 528 | foreach my $c ( $items->entries ) { |
|---|
| 529 | my $id = $c->id; |
|---|
| 530 | die unless $id; |
|---|
| 531 | ok( !exists($items{$id}), 'no dupe items - offset applied ' . $desc ); |
|---|
| 532 | $items{$id} = 1; |
|---|
| 533 | } |
|---|
| 534 | } |
|---|
| 535 | else { |
|---|
| 536 | die $resp->content(); |
|---|
| 537 | } |
|---|
| 538 | $uri->path($url . '/offset=' . ($limit*($i+1))); |
|---|
| 539 | } |
|---|
| 540 | } |
|---|
| 541 | |
|---|
| 542 | #offset and limit |
|---|
| 543 | { |
|---|
| 544 | my $uri = new URI; |
|---|
| 545 | my $limit = 3; |
|---|
| 546 | my $url = "/mt-atom.cgi/1.0/blog_id=1/limit=$limit"; |
|---|
| 547 | $uri->path($url); |
|---|
| 548 | |
|---|
| 549 | my $count = MT::Entry->count({ |
|---|
| 550 | blog_id => 1 |
|---|
| 551 | }); |
|---|
| 552 | |
|---|
| 553 | &_test_limit_offset( $uri, $url, $limit, $count, 'blog entries'); |
|---|
| 554 | |
|---|
| 555 | $url = "/mt-atom.cgi/comments/blog_id=1/limit=$limit"; |
|---|
| 556 | $uri->path($url); |
|---|
| 557 | |
|---|
| 558 | my $count = MT::Comment->count({ |
|---|
| 559 | blog_id => 1, visible => 1 |
|---|
| 560 | }); |
|---|
| 561 | |
|---|
| 562 | &_test_limit_offset( $uri, $url, $limit, $count, 'blog comments'); |
|---|
| 563 | |
|---|
| 564 | my $iter = MT::Comment->count_group_by( |
|---|
| 565 | { blog_id => 1, visible => 1 }, |
|---|
| 566 | { group => ['entry_id'], sort => [ { desc => 'DESC', column => '1' } ] |
|---|
| 567 | } |
|---|
| 568 | ); |
|---|
| 569 | |
|---|
| 570 | $limit = 2; |
|---|
| 571 | my $eid; |
|---|
| 572 | while ( ( $count, $eid ) = $iter->() ) { |
|---|
| 573 | if ( $count > 2 ) { |
|---|
| 574 | last; |
|---|
| 575 | } |
|---|
| 576 | } |
|---|
| 577 | # finish iterator cleanly |
|---|
| 578 | while ( my @dump = $iter->() ) {} |
|---|
| 579 | die unless $eid; |
|---|
| 580 | |
|---|
| 581 | $url = "/mt-atom.cgi/comments/blog_id=1/entry_id=$eid/limit=$limit"; |
|---|
| 582 | $uri->path($url); |
|---|
| 583 | |
|---|
| 584 | &_test_limit_offset($uri, $url, $limit, $count, 'entry comments'); |
|---|
| 585 | } |
|---|
| 586 | |
|---|
| 587 | END { |
|---|
| 588 | #my $melody = MT::Author->load({ name => $username }); |
|---|
| 589 | #$melody->delete() if $melody; |
|---|
| 590 | } |
|---|