From 3b0fce93e40e5457b63ceda9692901539eb4fc82 Mon Sep 17 00:00:00 2001 From: joey Date: Tue, 2 May 2006 06:53:33 +0000 Subject: [PATCH] * Split off an IkiWiki.pm out of ikiwiki and have all the other modules use it, this will allow for adding a unit test suite. --- IkiWiki.pm | 397 ++++++++++++++++++++++++++++++++++ IkiWiki/CGI.pm | 1 + IkiWiki/Plugin/brokenlinks.pm | 1 + IkiWiki/Plugin/inline.pm | 1 + IkiWiki/Plugin/orphans.pm | 1 + IkiWiki/Plugin/pagecount.pm | 1 + IkiWiki/Plugin/skeleton.pm | 1 + IkiWiki/Rcs/SVN.pm | 1 + IkiWiki/Rcs/Stub.pm | 1 + IkiWiki/Render.pm | 1 + IkiWiki/Setup.pm | 1 + IkiWiki/UserInfo.pm | 1 + IkiWiki/Wrapper.pm | 1 + debian/changelog | 4 +- doc/roadmap.mdwn | 4 +- ikiwiki | 391 +-------------------------------- 16 files changed, 416 insertions(+), 392 deletions(-) create mode 100644 IkiWiki.pm diff --git a/IkiWiki.pm b/IkiWiki.pm new file mode 100644 index 000000000..31228883f --- /dev/null +++ b/IkiWiki.pm @@ -0,0 +1,397 @@ +#!/usr/bin/perl + +package IkiWiki; +use warnings; +use strict; +use File::Spec; +use HTML::Template; + +use vars qw{%config %links %oldlinks %oldpagemtime %pagectime + %renderedfiles %pagesources %depends %plugins}; + +sub checkconfig () { #{{{ + if ($config{cgi} && ! length $config{url}) { + error("Must specify url to wiki with --url when using --cgi\n"); + } + if ($config{rss} && ! length $config{url}) { + error("Must specify url to wiki with --url when using --rss\n"); + } + if ($config{hyperestraier} && ! length $config{url}) { + error("Must specify --url when using --hyperestraier\n"); + } + + $config{wikistatedir}="$config{srcdir}/.ikiwiki" + unless exists $config{wikistatedir}; + + if ($config{svn}) { + require IkiWiki::Rcs::SVN; + $config{rcs}=1; + } + else { + require IkiWiki::Rcs::Stub; + $config{rcs}=0; + } + + foreach my $plugin (@{$config{plugin}}) { + my $mod="IkiWiki::Plugin::".possibly_foolish_untaint($plugin); + eval qq{use $mod}; + if ($@) { + error("Failed to load plugin $mod: $@"); + } + } +} #}}} + +sub error ($) { #{{{ + if ($config{cgi}) { + print "Content-type: text/html\n\n"; + print misctemplate("Error", "

Error: @_

"); + } + die @_; +} #}}} + +sub debug ($) { #{{{ + return unless $config{verbose}; + if (! $config{cgi}) { + print "@_\n"; + } + else { + print STDERR "@_\n"; + } +} #}}} + +sub possibly_foolish_untaint ($) { #{{{ + my $tainted=shift; + my ($untainted)=$tainted=~/(.*)/; + return $untainted; +} #}}} + +sub basename ($) { #{{{ + my $file=shift; + + $file=~s!.*/+!!; + return $file; +} #}}} + +sub dirname ($) { #{{{ + my $file=shift; + + $file=~s!/*[^/]+$!!; + return $file; +} #}}} + +sub pagetype ($) { #{{{ + my $page=shift; + + if ($page =~ /\.mdwn$/) { + return ".mdwn"; + } + else { + return "unknown"; + } +} #}}} + +sub pagename ($) { #{{{ + my $file=shift; + + my $type=pagetype($file); + my $page=$file; + $page=~s/\Q$type\E*$// unless $type eq 'unknown'; + return $page; +} #}}} + +sub htmlpage ($) { #{{{ + my $page=shift; + + return $page.".html"; +} #}}} + +sub srcfile ($) { #{{{ + my $file=shift; + + return "$config{srcdir}/$file" if -e "$config{srcdir}/$file"; + return "$config{underlaydir}/$file" if -e "$config{underlaydir}/$file"; + error("internal error: $file cannot be found"); +} #}}} + +sub readfile ($;$) { #{{{ + my $file=shift; + my $binary=shift; + + if (-l $file) { + error("cannot read a symlink ($file)"); + } + + local $/=undef; + open (IN, $file) || error("failed to read $file: $!"); + binmode(IN) if $binary; + my $ret=; + close IN; + return $ret; +} #}}} + +sub writefile ($$$;$) { #{{{ + my $file=shift; # can include subdirs + my $destdir=shift; # directory to put file in + my $content=shift; + my $binary=shift; + + my $test=$file; + while (length $test) { + if (-l "$destdir/$test") { + error("cannot write to a symlink ($test)"); + } + $test=dirname($test); + } + + my $dir=dirname("$destdir/$file"); + if (! -d $dir) { + my $d=""; + foreach my $s (split(m!/+!, $dir)) { + $d.="$s/"; + if (! -d $d) { + mkdir($d) || error("failed to create directory $d: $!"); + } + } + } + + open (OUT, ">$destdir/$file") || error("failed to write $destdir/$file: $!"); + binmode(OUT) if $binary; + print OUT $content; + close OUT; +} #}}} + +sub bestlink ($$) { #{{{ + # Given a page and the text of a link on the page, determine which + # existing page that link best points to. Prefers pages under a + # subdirectory with the same name as the source page, failing that + # goes down the directory tree to the base looking for matching + # pages. + my $page=shift; + my $link=lc(shift); + + my $cwd=$page; + do { + my $l=$cwd; + $l.="/" if length $l; + $l.=$link; + + if (exists $links{$l}) { + #debug("for $page, \"$link\", use $l"); + return $l; + } + } while $cwd=~s!/?[^/]+$!!; + + #print STDERR "warning: page $page, broken link: $link\n"; + return ""; +} #}}} + +sub isinlinableimage ($) { #{{{ + my $file=shift; + + $file=~/\.(png|gif|jpg|jpeg)$/i; +} #}}} + +sub pagetitle ($) { #{{{ + my $page=shift; + $page=~s/__(\d+)__/&#$1;/g; + $page=~y/_/ /; + return $page; +} #}}} + +sub titlepage ($) { #{{{ + my $title=shift; + $title=~y/ /_/; + $title=~s/([^-[:alnum:]_:+\/.])/"__".ord($1)."__"/eg; + return $title; +} #}}} + +sub cgiurl (@) { #{{{ + my %params=@_; + + return $config{cgiurl}."?".join("&", map "$_=$params{$_}", keys %params); +} #}}} + +sub styleurl (;$) { #{{{ + my $page=shift; + + return "$config{url}/style.css" if ! defined $page; + + $page=~s/[^\/]+$//; + $page=~s/[^\/]+\//..\//g; + return $page."style.css"; +} #}}} + +sub htmllink ($$;$$$) { #{{{ + my $page=shift; + my $link=shift; + my $noimageinline=shift; # don't turn links into inline html images + my $forcesubpage=shift; # force a link to a subpage + my $linktext=shift; # set to force the link text to something + + my $bestlink; + if (! $forcesubpage) { + $bestlink=bestlink($page, $link); + } + else { + $bestlink="$page/".lc($link); + } + + $linktext=pagetitle(basename($link)) unless defined $linktext; + + return $linktext if length $bestlink && $page eq $bestlink; + + # TODO BUG: %renderedfiles may not have it, if the linked to page + # was also added and isn't yet rendered! Note that this bug is + # masked by the bug mentioned below that makes all new files + # be rendered twice. + if (! grep { $_ eq $bestlink } values %renderedfiles) { + $bestlink=htmlpage($bestlink); + } + if (! grep { $_ eq $bestlink } values %renderedfiles) { + return " "create", page => $link, from =>$page). + "\">?$linktext" + } + + $bestlink=File::Spec->abs2rel($bestlink, dirname($page)); + + if (! $noimageinline && isinlinableimage($bestlink)) { + return "\"$linktext\""; + } + return "$linktext"; +} #}}} + +sub indexlink () { #{{{ + return "$config{wikiname}"; +} #}}} + +sub lockwiki () { #{{{ + # Take an exclusive lock on the wiki to prevent multiple concurrent + # run issues. The lock will be dropped on program exit. + if (! -d $config{wikistatedir}) { + mkdir($config{wikistatedir}); + } + open(WIKILOCK, ">$config{wikistatedir}/lockfile") || + error ("cannot write to $config{wikistatedir}/lockfile: $!"); + if (! flock(WIKILOCK, 2 | 4)) { + debug("wiki seems to be locked, waiting for lock"); + my $wait=600; # arbitrary, but don't hang forever to + # prevent process pileup + for (1..600) { + return if flock(WIKILOCK, 2 | 4); + sleep 1; + } + error("wiki is locked; waited $wait seconds without lock being freed (possible stuck process or stale lock?)"); + } +} #}}} + +sub unlockwiki () { #{{{ + close WIKILOCK; +} #}}} + +sub loadindex () { #{{{ + open (IN, "$config{wikistatedir}/index") || return; + while () { + $_=possibly_foolish_untaint($_); + chomp; + my %items; + $items{link}=[]; + foreach my $i (split(/ /, $_)) { + my ($item, $val)=split(/=/, $i, 2); + push @{$items{$item}}, $val; + } + + next unless exists $items{src}; # skip bad lines for now + + my $page=pagename($items{src}[0]); + if (! $config{rebuild}) { + $pagesources{$page}=$items{src}[0]; + $oldpagemtime{$page}=$items{mtime}[0]; + $oldlinks{$page}=[@{$items{link}}]; + $links{$page}=[@{$items{link}}]; + $depends{$page}=join(" ", @{$items{depends}}) + if exists $items{depends}; + $renderedfiles{$page}=$items{dest}[0]; + } + $pagectime{$page}=$items{ctime}[0]; + } + close IN; +} #}}} + +sub saveindex () { #{{{ + if (! -d $config{wikistatedir}) { + mkdir($config{wikistatedir}); + } + open (OUT, ">$config{wikistatedir}/index") || + error("cannot write to $config{wikistatedir}/index: $!"); + foreach my $page (keys %oldpagemtime) { + next unless $oldpagemtime{$page}; + my $line="mtime=$oldpagemtime{$page} ". + "ctime=$pagectime{$page} ". + "src=$pagesources{$page} ". + "dest=$renderedfiles{$page}"; + $line.=" link=$_" foreach @{$links{$page}}; + if (exists $depends{$page}) { + $line.=" depends=$_" foreach split " ", $depends{$page}; + } + print OUT $line."\n"; + } + close OUT; +} #}}} + +sub misctemplate ($$) { #{{{ + my $title=shift; + my $pagebody=shift; + + my $template=HTML::Template->new( + filename => "$config{templatedir}/misc.tmpl" + ); + $template->param( + title => $title, + indexlink => indexlink(), + wikiname => $config{wikiname}, + pagebody => $pagebody, + styleurl => styleurl(), + baseurl => "$config{url}/", + ); + return $template->output; +}#}}} + +sub glob_match ($$) { #{{{ + my $page=shift; + my $glob=shift; + + # turn glob into safe regexp + $glob=quotemeta($glob); + $glob=~s/\\\*/.*/g; + $glob=~s/\\\?/./g; + $glob=~s!\\/!/!g; + + $page=~/^$glob$/i; +} #}}} + +sub globlist_match ($$) { #{{{ + my $page=shift; + my @globlist=split(" ", shift); + + # check any negated globs first + foreach my $glob (@globlist) { + return 0 if $glob=~/^!(.*)/ && glob_match($page, $1); + } + + foreach my $glob (@globlist) { + return 1 if glob_match($page, $glob); + } + + return 0; +} #}}} + +sub register_plugin ($$$) { # {{{ + my $type=shift; + my $command=shift; + my $function=shift; + + $plugins{$type}{$command}=$function; +} # }}} + +1 diff --git a/IkiWiki/CGI.pm b/IkiWiki/CGI.pm index 74ed2f217..e219c8c1c 100644 --- a/IkiWiki/CGI.pm +++ b/IkiWiki/CGI.pm @@ -2,6 +2,7 @@ use warnings; use strict; +use IkiWiki; use IkiWiki::UserInfo; package IkiWiki; diff --git a/IkiWiki/Plugin/brokenlinks.pm b/IkiWiki/Plugin/brokenlinks.pm index 9485da398..75c819d76 100644 --- a/IkiWiki/Plugin/brokenlinks.pm +++ b/IkiWiki/Plugin/brokenlinks.pm @@ -4,6 +4,7 @@ package IkiWiki::Plugin::brokenlinks; use warnings; use strict; +use IkiWiki; sub import { #{{{ IkiWiki::register_plugin("preprocess", "brokenlinks", \&preprocess); diff --git a/IkiWiki/Plugin/inline.pm b/IkiWiki/Plugin/inline.pm index 53ea5bf18..c554774f6 100644 --- a/IkiWiki/Plugin/inline.pm +++ b/IkiWiki/Plugin/inline.pm @@ -4,6 +4,7 @@ package IkiWiki::Plugin::inline; use warnings; use strict; +use IkiWiki; sub import { #{{{ IkiWiki::register_plugin("preprocess", "inline", \&IkiWiki::preprocess_inline); diff --git a/IkiWiki/Plugin/orphans.pm b/IkiWiki/Plugin/orphans.pm index 06b51bddc..bd3c6b8b9 100644 --- a/IkiWiki/Plugin/orphans.pm +++ b/IkiWiki/Plugin/orphans.pm @@ -4,6 +4,7 @@ package IkiWiki::Plugin::orphans; use warnings; use strict; +use IkiWiki; sub import { #{{{ IkiWiki::register_plugin("preprocess", "orphans", \&preprocess); diff --git a/IkiWiki/Plugin/pagecount.pm b/IkiWiki/Plugin/pagecount.pm index 865ab4c39..fc69e449b 100644 --- a/IkiWiki/Plugin/pagecount.pm +++ b/IkiWiki/Plugin/pagecount.pm @@ -4,6 +4,7 @@ package IkiWiki::Plugin::pagecount; use warnings; use strict; +use IkiWiki; sub import { #{{{ IkiWiki::register_plugin("preprocess", "pagecount", \&preprocess); diff --git a/IkiWiki/Plugin/skeleton.pm b/IkiWiki/Plugin/skeleton.pm index e8d3db0cc..c9a7a421d 100644 --- a/IkiWiki/Plugin/skeleton.pm +++ b/IkiWiki/Plugin/skeleton.pm @@ -5,6 +5,7 @@ package IkiWiki::Plugin::skeleton; use warnings; use strict; +use IkiWiki; sub import { #{{{ IkiWiki::register_plugin("preprocess", "skeleton", \&preprocess); diff --git a/IkiWiki/Rcs/SVN.pm b/IkiWiki/Rcs/SVN.pm index 358f46948..b45b69197 100644 --- a/IkiWiki/Rcs/SVN.pm +++ b/IkiWiki/Rcs/SVN.pm @@ -3,6 +3,7 @@ use warnings; use strict; +use IkiWiki; package IkiWiki; diff --git a/IkiWiki/Rcs/Stub.pm b/IkiWiki/Rcs/Stub.pm index 9bbfde352..15e6cfb48 100644 --- a/IkiWiki/Rcs/Stub.pm +++ b/IkiWiki/Rcs/Stub.pm @@ -3,6 +3,7 @@ use warnings; use strict; +use IkiWiki; package IkiWiki; diff --git a/IkiWiki/Render.pm b/IkiWiki/Render.pm index 9ece00157..35e279a68 100644 --- a/IkiWiki/Render.pm +++ b/IkiWiki/Render.pm @@ -5,6 +5,7 @@ package IkiWiki; use warnings; use strict; use File::Spec; +use IkiWiki; sub linkify ($$) { #{{{ my $content=shift; diff --git a/IkiWiki/Setup.pm b/IkiWiki/Setup.pm index 40ed78862..9f210dec8 100644 --- a/IkiWiki/Setup.pm +++ b/IkiWiki/Setup.pm @@ -2,6 +2,7 @@ use warnings; use strict; +use IkiWiki; package IkiWiki; diff --git a/IkiWiki/UserInfo.pm b/IkiWiki/UserInfo.pm index 9a165dad1..fabe495bb 100644 --- a/IkiWiki/UserInfo.pm +++ b/IkiWiki/UserInfo.pm @@ -3,6 +3,7 @@ use warnings; use strict; use Storable; +use IkiWiki; package IkiWiki; diff --git a/IkiWiki/Wrapper.pm b/IkiWiki/Wrapper.pm index d72368446..e5f718f71 100644 --- a/IkiWiki/Wrapper.pm +++ b/IkiWiki/Wrapper.pm @@ -4,6 +4,7 @@ use warnings; use strict; use Cwd q{abs_path}; use Data::Dumper; +use IkiWiki; package IkiWiki; diff --git a/debian/changelog b/debian/changelog index 5e1c05f30..192b49dae 100644 --- a/debian/changelog +++ b/debian/changelog @@ -24,8 +24,10 @@ ikiwiki (1.1) UNRELEASED; urgency=low different location) already exists. * Add an orphans plugin for finding pages that nothing links to. * Removed backlinks page, which it turns out nothing used. + * Split off an IkiWiki.pm out of ikiwiki and have all the other modules use + it, this will allow for adding a unit test suite. - -- Joey Hess Tue, 2 May 2006 01:45:34 -0400 + -- Joey Hess Tue, 2 May 2006 02:51:06 -0400 ikiwiki (1.0) unstable; urgency=low diff --git a/doc/roadmap.mdwn b/doc/roadmap.mdwn index 929dd8b96..3450dbad2 100644 --- a/doc/roadmap.mdwn +++ b/doc/roadmap.mdwn @@ -11,9 +11,11 @@ Released 29 April 2006. # 2.0 +* Unit test suite (with tests of at least core stuff like + [[GlobList]]). * [[todo/Plugin]] mechanism. * Should have fully working [[todo/utf8]] support. * [[Optimised_rendering|todo/optimisations]] if possible. Deal with other scalability issues. * improved [[todo/html]] stylesheets and templates * A version of the logo in a different font, possibly with the dots on the i's highlighted in some other color. -* Support for at least one RCS aside from svn. Once it supports two, it should quickly grow to support them all.. \ No newline at end of file +* Support for at least one RCS aside from svn. Once it supports two, it should quickly grow to support them all.. diff --git a/ikiwiki b/ikiwiki index 8367e9118..75114bb66 100755 --- a/ikiwiki +++ b/ikiwiki @@ -4,12 +4,8 @@ $ENV{PATH}="/usr/local/bin:/usr/bin:/bin"; package IkiWiki; use warnings; use strict; -use File::Spec; -use HTML::Template; use lib '.'; # For use without installation, removed by Makefile. - -use vars qw{%config %links %oldlinks %oldpagemtime %pagectime - %renderedfiles %pagesources %depends %plugins}; +use IkiWiki; sub usage () { #{{{ die "usage: ikiwiki [options] source dest\n"; @@ -111,391 +107,6 @@ sub getconfig () { #{{{ } } #}}} -sub checkconfig () { #{{{ - if ($config{cgi} && ! length $config{url}) { - error("Must specify url to wiki with --url when using --cgi\n"); - } - if ($config{rss} && ! length $config{url}) { - error("Must specify url to wiki with --url when using --rss\n"); - } - if ($config{hyperestraier} && ! length $config{url}) { - error("Must specify --url when using --hyperestraier\n"); - } - - $config{wikistatedir}="$config{srcdir}/.ikiwiki" - unless exists $config{wikistatedir}; - - if ($config{svn}) { - require IkiWiki::Rcs::SVN; - $config{rcs}=1; - } - else { - require IkiWiki::Rcs::Stub; - $config{rcs}=0; - } - - foreach my $plugin (@{$config{plugin}}) { - my $mod="IkiWiki::Plugin::".possibly_foolish_untaint($plugin); - eval qq{use $mod}; - if ($@) { - error("Failed to load plugin $mod: $@"); - } - } -} #}}} - -sub error ($) { #{{{ - if ($config{cgi}) { - print "Content-type: text/html\n\n"; - print misctemplate("Error", "

Error: @_

"); - } - die @_; -} #}}} - -sub possibly_foolish_untaint ($) { #{{{ - my $tainted=shift; - my ($untainted)=$tainted=~/(.*)/; - return $untainted; -} #}}} - -sub debug ($) { #{{{ - return unless $config{verbose}; - if (! $config{cgi}) { - print "@_\n"; - } - else { - print STDERR "@_\n"; - } -} #}}} - -sub basename ($) { #{{{ - my $file=shift; - - $file=~s!.*/+!!; - return $file; -} #}}} - -sub dirname ($) { #{{{ - my $file=shift; - - $file=~s!/*[^/]+$!!; - return $file; -} #}}} - -sub pagetype ($) { #{{{ - my $page=shift; - - if ($page =~ /\.mdwn$/) { - return ".mdwn"; - } - else { - return "unknown"; - } -} #}}} - -sub pagename ($) { #{{{ - my $file=shift; - - my $type=pagetype($file); - my $page=$file; - $page=~s/\Q$type\E*$// unless $type eq 'unknown'; - return $page; -} #}}} - -sub htmlpage ($) { #{{{ - my $page=shift; - - return $page.".html"; -} #}}} - -sub srcfile ($) { #{{{ - my $file=shift; - - return "$config{srcdir}/$file" if -e "$config{srcdir}/$file"; - return "$config{underlaydir}/$file" if -e "$config{underlaydir}/$file"; - error("internal error: $file cannot be found"); -} #}}} - -sub readfile ($;$) { #{{{ - my $file=shift; - my $binary=shift; - - if (-l $file) { - error("cannot read a symlink ($file)"); - } - - local $/=undef; - open (IN, $file) || error("failed to read $file: $!"); - binmode(IN) if $binary; - my $ret=; - close IN; - return $ret; -} #}}} - -sub writefile ($$$;$) { #{{{ - my $file=shift; # can include subdirs - my $destdir=shift; # directory to put file in - my $content=shift; - my $binary=shift; - - my $test=$file; - while (length $test) { - if (-l "$destdir/$test") { - error("cannot write to a symlink ($test)"); - } - $test=dirname($test); - } - - my $dir=dirname("$destdir/$file"); - if (! -d $dir) { - my $d=""; - foreach my $s (split(m!/+!, $dir)) { - $d.="$s/"; - if (! -d $d) { - mkdir($d) || error("failed to create directory $d: $!"); - } - } - } - - open (OUT, ">$destdir/$file") || error("failed to write $destdir/$file: $!"); - binmode(OUT) if $binary; - print OUT $content; - close OUT; -} #}}} - -sub bestlink ($$) { #{{{ - # Given a page and the text of a link on the page, determine which - # existing page that link best points to. Prefers pages under a - # subdirectory with the same name as the source page, failing that - # goes down the directory tree to the base looking for matching - # pages. - my $page=shift; - my $link=lc(shift); - - my $cwd=$page; - do { - my $l=$cwd; - $l.="/" if length $l; - $l.=$link; - - if (exists $links{$l}) { - #debug("for $page, \"$link\", use $l"); - return $l; - } - } while $cwd=~s!/?[^/]+$!!; - - #print STDERR "warning: page $page, broken link: $link\n"; - return ""; -} #}}} - -sub isinlinableimage ($) { #{{{ - my $file=shift; - - $file=~/\.(png|gif|jpg|jpeg)$/i; -} #}}} - -sub pagetitle ($) { #{{{ - my $page=shift; - $page=~s/__(\d+)__/&#$1;/g; - $page=~y/_/ /; - return $page; -} #}}} - -sub titlepage ($) { #{{{ - my $title=shift; - $title=~y/ /_/; - $title=~s/([^-[:alnum:]_:+\/.])/"__".ord($1)."__"/eg; - return $title; -} #}}} - -sub cgiurl (@) { #{{{ - my %params=@_; - - return $config{cgiurl}."?".join("&", map "$_=$params{$_}", keys %params); -} #}}} - -sub styleurl (;$) { #{{{ - my $page=shift; - - return "$config{url}/style.css" if ! defined $page; - - $page=~s/[^\/]+$//; - $page=~s/[^\/]+\//..\//g; - return $page."style.css"; -} #}}} - -sub htmllink ($$;$$$) { #{{{ - my $page=shift; - my $link=shift; - my $noimageinline=shift; # don't turn links into inline html images - my $forcesubpage=shift; # force a link to a subpage - my $linktext=shift; # set to force the link text to something - - my $bestlink; - if (! $forcesubpage) { - $bestlink=bestlink($page, $link); - } - else { - $bestlink="$page/".lc($link); - } - - $linktext=pagetitle(basename($link)) unless defined $linktext; - - return $linktext if length $bestlink && $page eq $bestlink; - - # TODO BUG: %renderedfiles may not have it, if the linked to page - # was also added and isn't yet rendered! Note that this bug is - # masked by the bug mentioned below that makes all new files - # be rendered twice. - if (! grep { $_ eq $bestlink } values %renderedfiles) { - $bestlink=htmlpage($bestlink); - } - if (! grep { $_ eq $bestlink } values %renderedfiles) { - return " "create", page => $link, from =>$page). - "\">?$linktext" - } - - $bestlink=File::Spec->abs2rel($bestlink, dirname($page)); - - if (! $noimageinline && isinlinableimage($bestlink)) { - return "\"$linktext\""; - } - return "$linktext"; -} #}}} - -sub indexlink () { #{{{ - return "$config{wikiname}"; -} #}}} - -sub lockwiki () { #{{{ - # Take an exclusive lock on the wiki to prevent multiple concurrent - # run issues. The lock will be dropped on program exit. - if (! -d $config{wikistatedir}) { - mkdir($config{wikistatedir}); - } - open(WIKILOCK, ">$config{wikistatedir}/lockfile") || - error ("cannot write to $config{wikistatedir}/lockfile: $!"); - if (! flock(WIKILOCK, 2 | 4)) { - debug("wiki seems to be locked, waiting for lock"); - my $wait=600; # arbitrary, but don't hang forever to - # prevent process pileup - for (1..600) { - return if flock(WIKILOCK, 2 | 4); - sleep 1; - } - error("wiki is locked; waited $wait seconds without lock being freed (possible stuck process or stale lock?)"); - } -} #}}} - -sub unlockwiki () { #{{{ - close WIKILOCK; -} #}}} - -sub loadindex () { #{{{ - open (IN, "$config{wikistatedir}/index") || return; - while () { - $_=possibly_foolish_untaint($_); - chomp; - my %items; - $items{link}=[]; - foreach my $i (split(/ /, $_)) { - my ($item, $val)=split(/=/, $i, 2); - push @{$items{$item}}, $val; - } - - next unless exists $items{src}; # skip bad lines for now - - my $page=pagename($items{src}[0]); - if (! $config{rebuild}) { - $pagesources{$page}=$items{src}[0]; - $oldpagemtime{$page}=$items{mtime}[0]; - $oldlinks{$page}=[@{$items{link}}]; - $links{$page}=[@{$items{link}}]; - $depends{$page}=join(" ", @{$items{depends}}) - if exists $items{depends}; - $renderedfiles{$page}=$items{dest}[0]; - } - $pagectime{$page}=$items{ctime}[0]; - } - close IN; -} #}}} - -sub saveindex () { #{{{ - if (! -d $config{wikistatedir}) { - mkdir($config{wikistatedir}); - } - open (OUT, ">$config{wikistatedir}/index") || - error("cannot write to $config{wikistatedir}/index: $!"); - foreach my $page (keys %oldpagemtime) { - next unless $oldpagemtime{$page}; - my $line="mtime=$oldpagemtime{$page} ". - "ctime=$pagectime{$page} ". - "src=$pagesources{$page} ". - "dest=$renderedfiles{$page}"; - $line.=" link=$_" foreach @{$links{$page}}; - if (exists $depends{$page}) { - $line.=" depends=$_" foreach split " ", $depends{$page}; - } - print OUT $line."\n"; - } - close OUT; -} #}}} - -sub misctemplate ($$) { #{{{ - my $title=shift; - my $pagebody=shift; - - my $template=HTML::Template->new( - filename => "$config{templatedir}/misc.tmpl" - ); - $template->param( - title => $title, - indexlink => indexlink(), - wikiname => $config{wikiname}, - pagebody => $pagebody, - styleurl => styleurl(), - baseurl => "$config{url}/", - ); - return $template->output; -}#}}} - -sub glob_match ($$) { #{{{ - my $page=shift; - my $glob=shift; - - # turn glob into safe regexp - $glob=quotemeta($glob); - $glob=~s/\\\*/.*/g; - $glob=~s/\\\?/./g; - $glob=~s!\\/!/!g; - - $page=~/^$glob$/i; -} #}}} - -sub globlist_match ($$) { #{{{ - my $page=shift; - my @globlist=split(" ", shift); - - # check any negated globs first - foreach my $glob (@globlist) { - return 0 if $glob=~/^!(.*)/ && glob_match($page, $1); - } - - foreach my $glob (@globlist) { - return 1 if glob_match($page, $glob); - } - - return 0; -} #}}} - -sub register_plugin ($$$) { # {{{ - my $type=shift; - my $command=shift; - my $function=shift; - - $plugins{$type}{$command}=$function; -} # }}} - sub main () { #{{{ getconfig(); -- 2.44.0