# 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 package OddMuse; use lib '.'; use XML::LibXML; use Encode; # Import the functions $RunCGI = 0; # don't print HTML on stdout $UseConfig = 0; # don't read module files require 'wiki.pl'; Init(); use vars qw($redirect); my $resultfile = "/tmp/test-markup-result-$$"; 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); } sub update_page { my ($id, $text, $summary, $minor, $admin, @rest) = @_; 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; } sub get_page { open(F,"perl wiki.pl @_ |"); my $output = ; close F; return $output; } sub name { $_ = shift; s/\n/\\n/g; $_ = substr($_, 0, 60) . '...' if length > 63; return $_; } sub newlines { my @strings = @_; return map { s/\\n/\n/g; $_; } @strings; } # alternating input and output strings for applying rules sub run_tests { # translate embedded newlines (other backslashes remain untouched) my @tests = newlines(@_); my ($input, $output); while (($input, $output, @tests) = @tests) { my $result = apply_rules($input); is($result, $output, name($input)); } } 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; } # alternating input and output strings for applying macros instead of rules sub run_macro_tests { # translate embedded newlines (other backslashes remain untouched) my %test = map { s/\\n/\n/g; $_; } @_; # Note that the order of tests is not specified! foreach my $input (keys %test) { $_ = $input; foreach my $macro (@MyMacros) { &$macro; } is($_, $test{$input}, $input); } } # one string, many tests sub test_page { my $page = shift; foreach my $str (@_) { like($page, qr($str), name($str)); } } # one string, many negative tests sub test_page_negative { my $page = shift; foreach my $str (@_) { unlike($page, qr($str), name($str)); } } sub xpath_do { my ($check, $message, $page, @tests) = @_; $page =~ s/^.*?//s; # strip headers my $parser = XML::LibXML->new(); my $doc; my $result; SKIP: { eval { $doc = $parser->parse_html_string($page) }; skip("Cannot parse ".name($page).": $@", $#tests + 1) if $@; foreach my $test (@tests) { my $nodelist; eval { $nodelist = $doc->findnodes($test) }; if ($@) { fail("$test: $@"); } elsif (ok(&$check($nodelist->size()), name($test))) { $result .= $nodelist->string_value(); } else { $page =~ s/^.*? 0; }, "No Matches\n", @_); } sub negative_xpath_test { xpath_do(sub { shift == 0; }, "Unexpected Matches\n", @_); } sub xpath_run_tests { # translate embedded newlines (other backslashes remain untouched) my @tests = newlines(@_); my ($input, $output); while (($input, $output, @tests) = @tests) { my $result = apply_rules($input); xpath_test("

$result

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