From e1a5d27f190f9c052e10134174e32e4e64a5ebc8 Mon Sep 17 00:00:00 2001 From: Alex Schroeder Date: Mon, 18 Sep 2006 00:06:31 +0000 Subject: [PATCH] new test suite for atom with some subs from the original ../test.pl --- t/atom-test.t | 124 ++++++++++++++++++ t/test.pl | 338 ++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 462 insertions(+) create mode 100644 t/atom-test.t create mode 100755 t/test.pl diff --git a/t/atom-test.t b/t/atom-test.t new file mode 100644 index 00000000..6eefdec0 --- /dev/null +++ b/t/atom-test.t @@ -0,0 +1,124 @@ +#!/usr/bin/perl + +do 'test.pl'; + +package OddMuse; + +use XML::Atom::Client; +use XML::Atom::Entry; +use XML::Atom::Person; +use Test::More tests => 42; + +clear_pages(); + +print "Preparing new entry\n"; + +my $api = XML::Atom::Client->new; +my $entry = XML::Atom::Entry->new; +my $title = 'New Post'; +my $summary = 'Created'; +my $content = 'Content of my post ' . rand(999) . "\n"; +my $username = 'Alex'; +ok($entry->title($title), 'set post title'); +ok($entry->summary($summary), 'set post summary'); +ok($entry->content($content), 'set post content'); +my $author = XML::Atom::Person->new; +ok($author->name($username), 'set author name'); +ok($entry->author($author), 'set entry author'); +my $PostURI = 'http://localhost/cgi-bin/wiki.pl/atom'; +my $MemberURI = $api->createEntry($PostURI, $entry); +ok($MemberURI, 'posting entry returns member URI') + or diag($api->errstr); + +my $result = $api->getEntry($MemberURI); +ok($result, 'get created entry') + or diag($api->errstr); +ok($result->title eq $title, 'verify title'); +ok($result->summary eq $summary, 'verify summary'); +ok($result->content->body eq $content, 'verify content'); +ok($result->author->name eq $username, 'verify author'); +$MemberURI = ''; +my @links = ($result->link); +ok($#links >= 0, 'verify link'); +for my $link (@links) { + if ($link->rel eq 'edit') { + $MemberURI = $link->href; + last; + } else { + print "Ignoring ", $link->href, "\n"; + } +} +ok($MemberURI, 'entry contains member URI'); + +$summary = 'Updated'; +$content = "No more random numbers!\n"; +ok($entry->summary($summary), 'change summary'); +ok($entry->content($content), 'change content'); +ok($api->updateEntry($MemberURI, $entry), 'update entry') + or diag($api->errstr); + +$result = $api->getEntry($MemberURI); +ok($result, 'get updated entry') + or diag($api->errstr); +ok($result->title eq $title, 'verify title'); +ok($result->summary eq $summary, 'verify summary'); +ok($result->content->body eq $content, 'verify content'); +ok($result->author->name eq $username, 'verify author'); + +my $new_title = 'Same old post'; +ok($entry->title($new_title), 'rename entry'); +ok($api->updateEntry($MemberURI, $entry), 'post renamed entry') + or diag($api->errstr); + +$result = $api->getEntry($MemberURI); +ok($result, 'get renamed old entry') + or diag($api->errstr); + +ok($result->title eq $title, 'verify title'); +ok($result->summary eq "Renamed to $new_title", 'verify summary'); +ok($result->content->body eq 'DeletedPage', 'verify deleted page'); +ok($result->author->name eq $username, 'verify author'); + +my $FeedURI = 'http://localhost/cgi-bin/wiki.pl/atom/feed'; +my $feed = $api->getFeed($FeedURI); +ok($feed, 'checking feed'); +my @entries = $feed->entries; +ok($#entries >= 1, 'verify feed entries'); # at least 2, start at 0 +$result = undef; +for $entry (@entries) { + if ($entry->author and $entry->author->name eq $username + and $entry->title eq $new_title) { + $result = $entry; + last; + } +} +ok($result, 'result found in the feed'); +ok($result->title eq $new_title, 'verify title'); +ok($result->summary eq $summary, 'verify summary'); +ok(!$result->content, 'no content in the default feed'); +ok($result->author->name eq $username, 'verify author'); + +$FeedURI = 'http://localhost/cgi-bin/wiki.pl/atom/full/feed?rsslimit=2'; +my $feed = $api->getFeed($FeedURI); +ok($feed, 'checking full feed'); +my @entries = $feed->entries; +ok($#entries >= 1, 'verify full feed entries'); # at least 2, start at 0 +$result = undef; +for $entry (@entries) { + if ($entry->author and $entry->author->name eq $username + and $entry->title eq $new_title) { + $result = $entry; + last; + } +} +ok($result, 'result found in the full feed'); +ok($result->title eq $new_title, 'verify title'); +ok($result->summary eq $summary, 'verify summary'); +sub trim { + $_ = shift; + s/^\s+//g; + s/\s+$//g; + return $_; +} +ok(trim($result->content->body) eq ("

" . trim($content) . '

'), 'verify content'); +ok($result->author->name eq $username, 'verify author'); diff --git a/t/test.pl b/t/test.pl new file mode 100755 index 00000000..cd7e1178 --- /dev/null +++ b/t/test.pl @@ -0,0 +1,338 @@ +#!/usr/bin/perl + +# Copyright (C) 2004, 2005, 2006 Alex Schroeder +# +# This program is free software; you can redistribute it and/or modify +# it under the terms of the GNU General Public License as published by +# the Free Software Foundation; either version 2 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program; if not, write to the +# Free Software Foundation, Inc. +# 59 Temple Place, Suite 330 +# Boston, MA 02111-1307 USA + +use XML::LibXML; +use Encode; + +# Import the functions + +package OddMuse; +$RunCGI = 0; # don't print HTML on stdout +$UseConfig = 0; # don't read module files +do 'wiki.pl'; +Init(); + +my ($passed, $failed) = (0, 0); +my $resultfile = "/tmp/test-markup-result-$$"; +my $redirect; +undef $/; +$| = 1; # no output buffering + +sub url_encode { + my $str = shift; + return '' unless $str; + my @letters = split(//, $str); + my @safe = ('a' .. 'z', 'A' .. 'Z', '0' .. '9', '-', '_', '.'); # shell metachars are unsafe + foreach my $letter (@letters) { + my $pattern = quotemeta($letter); + if (not grep(/$pattern/, @safe)) { + $letter = sprintf("%%%02x", ord($letter)); + } + } + return join('', @letters); +} + +print "* means that a page is being updated\n"; +sub update_page { + my ($id, $text, $summary, $minor, $admin, @rest) = @_; + print '*'; + my $pwd = $admin ? 'foo' : 'wrong'; + $id = url_encode($id); + $text = url_encode($text); + $summary = url_encode($summary); + $minor = $minor ? 'on' : 'off'; + my $rest = join(' ', @rest); + $redirect = `perl wiki.pl Save=1 title=$id summary=$summary recent_edit=$minor text=$text pwd=$pwd $rest`; + $output = `perl wiki.pl action=browse id=$id`; + # just in case a new page got created or NearMap or InterMap + $IndexInit = 0; + $NearInit = 0; + $InterInit = 0; + $RssInterwikiTranslateInit = 0; + InitVariables(); + return $output; +} + +print "+ means that a page is being retrieved\n"; +sub get_page { + print '+'; + open(F,"perl wiki.pl @_ |"); + my $output = ; + close F; + return $output; +} + +print ". means a test\n"; +sub test_page { + my $page = shift; + my $printpage = 0; + foreach my $str (@_) { + print '.'; + if ($page =~ /$str/) { + $passed++; + } else { + $failed++; + $printpage = 1; + print "\nSimple Test: Did not find \"", $str, '"'; + } + } + print "\n\nPage content:\n", $page, "\n" if $printpage; +} + +sub test_page_negative { + my $page = shift; + my $printpage = 0; + foreach my $str (@_) { + print '.'; + if ($page =~ /$str/) { + $failed++; + $printpage = 1; + print "\nSimple negative Test: Found \"", $str, '"'; + } else { + $passed++; + } + } + print "\n\nPage content:\n", $page, "\n" if $printpage; +} + +sub get_text_via_xpath { + my ($page, $test) = @_; + $page =~ s/^.*?//s; # strip headers + my $parser = XML::LibXML->new(); + my $doc; + eval { $doc = $parser->parse_html_string($page) }; + if ($@) { + print "Could not parse html: $@\n", $page, "\n\n"; + $failed += 1; + } else { + print '.'; + my $nodelist; + eval { $nodelist = $doc->findnodes($test) }; + if ($@) { + $failed++; + print "\nXPATH Test: failed to run $test: $@\n"; + } elsif ($nodelist->size()) { + $passed++; + return $nodelist->string_value(); + } else { + $failed++; + print "\nXPATH Test: No matches for $test\n"; + $page =~ s/^.*?//s; # strip headers + my $parser = XML::LibXML->new(); + my $doc; + eval { $doc = $parser->parse_html_string($page) }; + if ($@) { + print "Could not parse html: ", substr($page,0,100), "\n"; + $failed += @tests; + } else { + foreach my $test (@tests) { + print '.'; + my $nodelist; + eval { $nodelist = $doc->findnodes($test) }; + if ($@) { + $failed++; + print "\nXPATH Test: failed to run $test: $@\n"; + } elsif ($nodelist->size()) { + $passed++; + } else { + $failed++; + print "\nXPATH Test: No matches for $test\n"; + $page =~ s/^.*?//s; # strip headers + my $parser = XML::LibXML->new(); + my $doc = $parser->parse_html_string($page); + foreach my $test (@tests) { + print '.'; + my $nodelist = $doc->findnodes($test); + if (not $nodelist->size()) { + $passed++; + } else { + $failed++; + $printpage = 1; + print "\nXPATH Test: Unexpected matches for $test\n"; + } + } +} + +sub apply_rules { + my $input = shift; + local *STDOUT; + $output = ''; + open(STDOUT, '>', \$output) or die "Can't open memory file: $!"; + $FootnoteNumber = 0; + ApplyRules(QuoteHtml($input), 1); + return $output; +} + + +sub xpath_run_tests { + # translate embedded newlines (other backslashes remain untouched) + my %New; + foreach (keys %Test) { + $Test{$_} =~ s/\\n/\n/g; + my $new = $Test{$_}; + s/\\n/\n/g; + $New{$_} = $new; + } + # Note that the order of tests is not specified! + my $output; + foreach my $input (keys %New) { + my $output = apply_rules($input); + xpath_test("
$output
", $New{$input}); + } +} + +sub test_match { + my ($input, @tests) = @_; + my $output = apply_rules($input); + foreach my $str (@tests) { + print '.'; + if ($output =~ /$str/) { + $passed++; + } else { + $failed++; + $printpage = 1; + print "\n\n---- input:\n", $input, + "\n---- output:\n", $output, + "\n---- instead of:\n", $str, "\n----\n"; + } + } +} + +sub run_tests { + # translate embedded newlines (other backslashes remain untouched) + my %New; + foreach (keys %Test) { + $Test{$_} =~ s/\\n/\n/g; + my $new = $Test{$_}; + s/\\n/\n/g; + $New{$_} = $new; + } + # Note that the order of tests is not specified! + foreach my $input (keys %New) { + print '.'; + my $output = apply_rules($input); + if ($output eq $New{$input}) { + $passed++; + } else { + $failed++; + print "\n\n---- input:\n", $input, + "\n---- output:\n", $output, + "\n---- instead of:\n", $New{$input}, "\n----\n"; + } + } +} + +sub run_macro_tests { + # translate embedded newlines (other backslashes remain untouched) + my %New; + foreach (keys %Test) { + $Test{$_} =~ s/\\n/\n/g; + my $new = $Test{$_}; + s/\\n/\n/g; + $New{$_} = $new; + } + # Note that the order of tests is not specified! + foreach my $input (keys %New) { + print '.'; + $_ = $input; + foreach my $macro (@MyMacros) { &$macro; } + my $output = $_; + if ($output eq $New{$input}) { + $passed++; + } else { + $failed++; + print "\n\n---- input:\n", $input, + "\n---- output:\n", $output, + "\n---- instead of:\n", $New{$input}, "\n----\n"; + } + } +} + +sub remove_rule { + my $rule = shift; + my @list = (); + my $found = 0; + foreach my $item (@MyRules) { + if ($item ne $rule) { + push @list, $item; + } else { + $found = 1; + } + } + die "Rule not found" unless $found; + @MyRules = @list; +} + +sub add_module { + my $mod = shift; + mkdir $ModuleDir unless -d $ModuleDir; + my $dir = `/bin/pwd`; + chop($dir); + symlink("$dir/modules/$mod", "$ModuleDir/$mod") or die "Cannot symlink $mod: $!" + unless -l "$ModuleDir/$mod"; + do "$ModuleDir/$mod"; + @MyRules = sort {$RuleOrder{$a} <=> $RuleOrder{$b}} @MyRules; +} + +sub remove_module { + my $mod = shift; + mkdir $ModuleDir unless -d $ModuleDir; + unlink("$ModuleDir/$mod") or die "Cannot unlink: $!"; +} + +sub clear_pages { + system('/bin/rm -rf /tmp/oddmuse'); + die "Cannot remove /tmp/oddmuse!\n" if -e '/tmp/oddmuse'; + mkdir '/tmp/oddmuse'; + open(F,'>/tmp/oddmuse/config'); + print F "\$AdminPass = 'foo';\n"; + # this used to be the default in earlier CGI.pm versions + print F "\$ScriptName = 'http://localhost/wiki.pl';\n"; + print F "\$SurgeProtection = 0;\n"; + close(F); + $ScriptName = 'http://localhost/test.pl'; # different! + $IndexInit = 0; + %IndexHash = (); + $InterSiteInit = 0; + %InterSite = (); + $NearSiteInit = 0; + %NearSite = (); + %NearSearch = (); +} + +1;