+ return $content;
+}
+
+our %preprocessing;
+our $preprocess_preview=0;
+sub preprocess ($$$;$$) {
+ my $page=shift; # the page the data comes from
+ my $destpage=shift; # the page the data will appear in (different for inline)
+ my $content=shift;
+ my $scan=shift;
+ my $preview=shift;
+
+ # Using local because it needs to be set within any nested calls
+ # of this function.
+ local $preprocess_preview=$preview if defined $preview;
+
+ my $handle=sub {
+ my $escape=shift;
+ my $prefix=shift;
+ my $command=shift;
+ my $params=shift;
+ $params="" if ! defined $params;
+
+ if (length $escape) {
+ return "[[$prefix$command $params]]";
+ }
+ elsif (exists $hooks{preprocess}{$command}) {
+ return "" if $scan && ! $hooks{preprocess}{$command}{scan};
+ # Note: preserve order of params, some plugins may
+ # consider it significant.
+ my @params;
+ while ($params =~ m{
+ (?:([-\w]+)=)? # 1: named parameter key?
+ (?:
+ """(.*?)""" # 2: triple-quoted value
+ |
+ "([^"]+)" # 3: single-quoted value
+ |
+ (\S+) # 4: unquoted value
+ )
+ (?:\s+|$) # delimiter to next param
+ }sgx) {
+ my $key=$1;
+ my $val;
+ if (defined $2) {
+ $val=$2;
+ $val=~s/\r\n/\n/mg;
+ $val=~s/^\n+//g;
+ $val=~s/\n+$//g;
+ }
+ elsif (defined $3) {
+ $val=$3;
+ }
+ elsif (defined $4) {
+ $val=$4;
+ }
+
+ if (defined $key) {
+ push @params, $key, $val;
+ }
+ else {
+ push @params, $val, '';
+ }
+ }
+ if ($preprocessing{$page}++ > 3) {
+ # Avoid loops of preprocessed pages preprocessing
+ # other pages that preprocess them, etc.
+ return "[[!$command <span class=\"error\">".
+ sprintf(gettext("preprocessing loop detected on %s at depth %i"),
+ $page, $preprocessing{$page}).
+ "</span>]]";
+ }
+ my $ret;
+ if (! $scan) {
+ $ret=eval {
+ $hooks{preprocess}{$command}{call}->(
+ @params,
+ page => $page,
+ destpage => $destpage,
+ preview => $preprocess_preview,
+ );
+ };
+ if ($@) {
+ my $error=$@;
+ chomp $error;
+ $ret="[[!$command <span class=\"error\">".
+ gettext("Error").": $error"."</span>]]";
+ }
+ }
+ else {
+ # use void context during scan pass
+ eval {
+ $hooks{preprocess}{$command}{call}->(
+ @params,
+ page => $page,
+ destpage => $destpage,
+ preview => $preprocess_preview,
+ );
+ };
+ $ret="";
+ }
+ $preprocessing{$page}--;
+ return $ret;
+ }
+ else {
+ return "[[$prefix$command $params]]";
+ }
+ };
+
+ my $regex;
+ if ($config{prefix_directives}) {
+ $regex = qr{
+ (\\?) # 1: escape?
+ \[\[(!) # directive open; 2: prefix
+ ([-\w]+) # 3: command
+ ( # 4: the parameters..
+ \s+ # Must have space if parameters present
+ (?:
+ (?:[-\w]+=)? # named parameter key?
+ (?:
+ """.*?""" # triple-quoted value
+ |
+ "[^"]+" # single-quoted value
+ |
+ [^"\s\]]+ # unquoted value
+ )
+ \s* # whitespace or end
+ # of directive
+ )
+ *)? # 0 or more parameters
+ \]\] # directive closed
+ }sx;
+ }
+ else {
+ $regex = qr{
+ (\\?) # 1: escape?
+ \[\[(!?) # directive open; 2: optional prefix
+ ([-\w]+) # 3: command
+ \s+
+ ( # 4: the parameters..
+ (?:
+ (?:[-\w]+=)? # named parameter key?
+ (?:
+ """.*?""" # triple-quoted value
+ |
+ "[^"]+" # single-quoted value
+ |
+ [^"\s\]]+ # unquoted value
+ )
+ \s* # whitespace or end
+ # of directive
+ )
+ *) # 0 or more parameters
+ \]\] # directive closed
+ }sx;
+ }
+
+ $content =~ s{$regex}{$handle->($1, $2, $3, $4)}eg;
+ return $content;
+}
+
+sub filter ($$$) {
+ my $page=shift;
+ my $destpage=shift;
+ my $content=shift;
+
+ run_hooks(filter => sub {
+ $content=shift->(page => $page, destpage => $destpage,
+ content => $content);
+ });
+
+ return $content;
+}
+
+sub indexlink () {
+ return "<a href=\"$config{url}\">$config{wikiname}</a>";
+}
+
+sub check_canedit ($$$;$) {
+ my $page=shift;
+ my $q=shift;
+ my $session=shift;
+ my $nonfatal=shift;
+
+ my $canedit;
+ run_hooks(canedit => sub {
+ return if defined $canedit;
+ my $ret=shift->($page, $q, $session);
+ if (defined $ret) {
+ if ($ret eq "") {
+ $canedit=1;
+ }
+ elsif (ref $ret eq 'CODE') {
+ $ret->() unless $nonfatal;
+ $canedit=0;
+ }
+ elsif (defined $ret) {
+ error($ret) unless $nonfatal;
+ $canedit=0;
+ }
+ }
+ });
+ return defined $canedit ? $canedit : 1;
+}
+
+sub check_content (@) {
+ my %params=@_;
+
+ return 1 if ! exists $hooks{checkcontent}; # optimisation
+
+ if (exists $pagesources{$params{page}}) {
+ my @diff;
+ my %old=map { $_ => 1 }
+ split("\n", readfile(srcfile($pagesources{$params{page}})));
+ foreach my $line (split("\n", $params{content})) {
+ push @diff, $line if ! exists $old{$_};
+ }
+ $params{diff}=join("\n", @diff);
+ }
+
+ my $ok;
+ run_hooks(checkcontent => sub {
+ return if defined $ok;
+ my $ret=shift->(%params);
+ if (defined $ret) {
+ if ($ret eq "") {
+ $ok=1;
+ }
+ elsif (ref $ret eq 'CODE') {
+ $ret->() unless $params{nonfatal};
+ $ok=0;
+ }
+ elsif (defined $ret) {
+ error($ret) unless $params{nonfatal};
+ $ok=0;
+ }
+ }
+
+ });
+ return defined $ok ? $ok : 1;
+}
+
+my $wikilock;
+
+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)) { # LOCK_EX
+ error("failed to get lock");
+ }
+ return 1;
+}
+
+sub unlockwiki () {
+ POSIX::close($ENV{IKIWIKI_CGILOCK_FD}) if exists $ENV{IKIWIKI_CGILOCK_FD};
+ return close($wikilock) if $wikilock;
+ return;
+}
+
+my $commitlock;
+
+sub commit_hook_enabled () {
+ open($commitlock, '+>', "$config{wikistatedir}/commitlock") ||
+ error("cannot write to $config{wikistatedir}/commitlock: $!");
+ if (! flock($commitlock, 1 | 4)) { # LOCK_SH | LOCK_NB to test
+ close($commitlock) || error("failed closing commitlock: $!");
+ return 0;
+ }
+ close($commitlock) || error("failed closing commitlock: $!");
+ return 1;
+}
+
+sub disable_commit_hook () {
+ open($commitlock, '>', "$config{wikistatedir}/commitlock") ||
+ error("cannot write to $config{wikistatedir}/commitlock: $!");
+ if (! flock($commitlock, 2)) { # LOCK_EX
+ error("failed to get commit lock");
+ }
+ return 1;
+}
+
+sub enable_commit_hook () {
+ return close($commitlock) if $commitlock;
+ return;
+}
+
+sub loadindex () {
+ %oldrenderedfiles=%pagectime=();
+ if (! $config{rebuild}) {
+ %pagesources=%pagemtime=%oldlinks=%links=%depends=
+ %destsources=%renderedfiles=%pagecase=%pagestate=
+ %depends_simple=();
+ }
+ my $in;
+ if (! open ($in, "<", "$config{wikistatedir}/indexdb")) {
+ if (-e "$config{wikistatedir}/index") {
+ system("ikiwiki-transition", "indexdb", $config{srcdir});
+ open ($in, "<", "$config{wikistatedir}/indexdb") || return;
+ }
+ else {
+ return;
+ }
+ }
+
+ my $index=Storable::fd_retrieve($in);
+ if (! defined $index) {
+ return 0;
+ }
+
+ my $pages;
+ if (exists $index->{version} && ! ref $index->{version}) {
+ $pages=$index->{page};
+ %wikistate=%{$index->{state}};
+ }
+ else {
+ $pages=$index;
+ %wikistate=();
+ }
+
+ foreach my $src (keys %$pages) {
+ my $d=$pages->{$src};
+ my $page=pagename($src);
+ $pagectime{$page}=$d->{ctime};
+ if (! $config{rebuild}) {
+ $pagesources{$page}=$src;
+ $pagemtime{$page}=$d->{mtime};
+ $renderedfiles{$page}=$d->{dest};
+ if (exists $d->{links} && ref $d->{links}) {
+ $links{$page}=$d->{links};
+ $oldlinks{$page}=[@{$d->{links}}];
+ }
+ if (ref $d->{depends_simple} eq 'ARRAY') {
+ # old format
+ $depends_simple{$page}={
+ map { $_ => 1 } @{$d->{depends_simple}}
+ };
+ }
+ elsif (exists $d->{depends_simple}) {
+ $depends_simple{$page}=$d->{depends_simple};
+ }
+ if (exists $d->{dependslist}) {
+ # old format
+ $depends{$page}={
+ map { $_ => $DEPEND_CONTENT }
+ @{$d->{dependslist}}
+ };
+ }
+ elsif (exists $d->{depends} && ! ref $d->{depends}) {
+ # old format
+ $depends{$page}={$d->{depends} => $DEPEND_CONTENT };
+ }
+ elsif (exists $d->{depends}) {
+ $depends{$page}=$d->{depends};
+ }
+ if (exists $d->{state}) {
+ $pagestate{$page}=$d->{state};
+ }
+ }
+ $oldrenderedfiles{$page}=[@{$d->{dest}}];
+ }
+ foreach my $page (keys %pagesources) {
+ $pagecase{lc $page}=$page;
+ }
+ foreach my $page (keys %renderedfiles) {
+ $destsources{$_}=$page foreach @{$renderedfiles{$page}};
+ }
+ return close($in);
+}
+
+sub saveindex () {
+ run_hooks(savestate => sub { shift->() });
+
+ my %hookids;
+ foreach my $type (keys %hooks) {
+ $hookids{$_}=1 foreach keys %{$hooks{$type}};
+ }
+ my @hookids=keys %hookids;
+
+ if (! -d $config{wikistatedir}) {
+ mkdir($config{wikistatedir});
+ }
+ my $newfile="$config{wikistatedir}/indexdb.new";
+ my $cleanup = sub { unlink($newfile) };
+ open (my $out, '>', $newfile) || error("cannot write to $newfile: $!", $cleanup);
+
+ my %index;
+ foreach my $page (keys %pagemtime) {
+ next unless $pagemtime{$page};
+ my $src=$pagesources{$page};
+
+ $index{page}{$src}={
+ ctime => $pagectime{$page},
+ mtime => $pagemtime{$page},
+ dest => $renderedfiles{$page},
+ links => $links{$page},
+ };
+
+ if (exists $depends{$page}) {
+ $index{page}{$src}{depends} = $depends{$page};
+ }
+
+ if (exists $depends_simple{$page}) {
+ $index{page}{$src}{depends_simple} = $depends_simple{$page};
+ }
+
+ if (exists $pagestate{$page}) {
+ foreach my $id (@hookids) {
+ foreach my $key (keys %{$pagestate{$page}{$id}}) {
+ $index{page}{$src}{state}{$id}{$key}=$pagestate{$page}{$id}{$key};
+ }
+ }
+ }
+ }
+
+ $index{state}={};
+ foreach my $id (@hookids) {
+ foreach my $key (keys %{$wikistate{$id}}) {
+ $index{state}{$id}{$key}=$wikistate{$id}{$key};
+ }
+ }
+
+ $index{version}="3";
+ my $ret=Storable::nstore_fd(\%index, $out);
+ return if ! defined $ret || ! $ret;
+ close $out || error("failed saving to $newfile: $!", $cleanup);
+ rename($newfile, "$config{wikistatedir}/indexdb") ||
+ error("failed renaming $newfile to $config{wikistatedir}/indexdb", $cleanup);
+
+ return 1;
+}
+
+sub template_file ($) {
+ my $template=shift;
+
+ foreach my $dir ($config{templatedir}, @{$config{templatedirs}},
+ "$installdir/share/ikiwiki/templates") {
+ return "$dir/$template" if -e "$dir/$template";
+ }
+ return;
+}
+
+sub template_params (@) {
+ my $filename=template_file(shift);
+
+ if (! defined $filename) {
+ return if wantarray;
+ return "";
+ }
+
+ my @ret=(
+ filter => sub {
+ my $text_ref = shift;
+ ${$text_ref} = decode_utf8(${$text_ref});
+ },
+ filename => $filename,
+ loop_context_vars => 1,
+ die_on_bad_params => 0,
+ @_
+ );
+ return wantarray ? @ret : {@ret};
+}
+
+sub template ($;@) {
+ require HTML::Template;
+ return HTML::Template->new(template_params(@_));
+}
+
+sub misctemplate ($$;@) {
+ my $title=shift;
+ my $pagebody=shift;
+
+ my $template=template("misc.tmpl");
+ $template->param(
+ title => $title,
+ indexlink => indexlink(),
+ wikiname => $config{wikiname},
+ pagebody => $pagebody,
+ baseurl => baseurl(),
+ @_,
+ );
+ run_hooks(pagetemplate => sub {
+ shift->(page => "", destpage => "", template => $template);
+ });
+ return $template->output;
+}
+
+sub hook (@) {
+ my %param=@_;
+
+ if (! exists $param{type} || ! ref $param{call} || ! exists $param{id}) {
+ error 'hook requires type, call, and id parameters';
+ }
+
+ return if $param{no_override} && exists $hooks{$param{type}}{$param{id}};
+
+ $hooks{$param{type}}{$param{id}}=\%param;
+ return 1;
+}
+
+sub run_hooks ($$) {
+ # Calls the given sub for each hook of the given type,
+ # passing it the hook function to call.
+ my $type=shift;
+ my $sub=shift;
+
+ if (exists $hooks{$type}) {
+ my (@first, @middle, @last);
+ foreach my $id (keys %{$hooks{$type}}) {
+ if ($hooks{$type}{$id}{first}) {
+ push @first, $id;
+ }
+ elsif ($hooks{$type}{$id}{last}) {
+ push @last, $id;
+ }
+ else {
+ push @middle, $id;
+ }
+ }
+ foreach my $id (@first, @middle, @last) {
+ $sub->($hooks{$type}{$id}{call});
+ }
+ }
+
+ return 1;
+}
+
+sub rcs_update () {
+ $hooks{rcs}{rcs_update}{call}->(@_);
+}
+
+sub rcs_prepedit ($) {
+ $hooks{rcs}{rcs_prepedit}{call}->(@_);
+}
+
+sub rcs_commit ($$$;$$) {
+ $hooks{rcs}{rcs_commit}{call}->(@_);
+}
+
+sub rcs_commit_staged ($$$) {
+ $hooks{rcs}{rcs_commit_staged}{call}->(@_);
+}
+
+sub rcs_add ($) {
+ $hooks{rcs}{rcs_add}{call}->(@_);
+}
+
+sub rcs_remove ($) {
+ $hooks{rcs}{rcs_remove}{call}->(@_);
+}
+
+sub rcs_rename ($$) {
+ $hooks{rcs}{rcs_rename}{call}->(@_);
+}
+
+sub rcs_recentchanges ($) {
+ $hooks{rcs}{rcs_recentchanges}{call}->(@_);
+}
+
+sub rcs_diff ($) {
+ $hooks{rcs}{rcs_diff}{call}->(@_);
+}
+
+sub rcs_getctime ($) {
+ $hooks{rcs}{rcs_getctime}{call}->(@_);
+}
+
+sub rcs_receive () {
+ $hooks{rcs}{rcs_receive}{call}->();
+}
+
+sub add_depends ($$;$) {
+ my $page=shift;
+ my $pagespec=shift;
+ my $deptype=shift || $DEPEND_CONTENT;
+
+ # Is the pagespec a simple page name?
+ if ($pagespec =~ /$config{wiki_file_regexp}/ &&
+ $pagespec !~ /[\s*?()!]/) {
+ $depends_simple{$page}{lc $pagespec} |= $deptype;
+ return 1;
+ }
+
+ # Analyse the pagespec, and match it against all pages
+ # to get a list of influences, and add explicit dependencies
+ # for those.
+ #my $sub=pagespec_translate($pagespec);
+ #return if $@;
+ #foreach my $p (keys %pagesources) {
+ # my $r=$sub->($p, location => $page );
+ # my %i=$r->influences;
+ # foreach my $i (keys %i) {
+ # $depends_simple{$page}{lc $i} |= $i{$i};
+ # }
+ #}
+ print STDERR "warning: use of add_depends; influences not tracked\n";
+
+ $depends{$page}{$pagespec} |= $deptype;
+ return 1;
+}
+
+sub use_pagespec ($$;@) {
+ my $page=shift;
+ my $pagespec=shift;
+ my %params=@_;
+
+ my $sub=pagespec_translate($pagespec);
+ error "syntax error in pagespec \"$pagespec\""
+ if $@ || ! defined $sub;
+
+ my @candidates;
+ if (exists $params{limit}) {
+ @candidates=grep { $params{limit}->($_) } keys %pagesources;
+ }
+ else {
+ @candidates=keys %pagesources;
+ }
+
+ if (defined $params{sort}) {
+ my $f;
+ if ($params{sort} eq 'title') {
+ $f=sub { pagetitle(basename($a)) cmp pagetitle(basename($b)) };
+ }
+ elsif ($params{sort} eq 'title_natural') {
+ eval q{use Sort::Naturally};
+ if ($@) {
+ error(gettext("Sort::Naturally needed for title_natural sort"));
+ }
+ $f=sub { Sort::Naturally::ncmp(pagetitle(basename($a)), pagetitle(basename($b))) };
+ }
+ elsif ($params{sort} eq 'mtime') {
+ $f=sub { $pagemtime{$b} <=> $pagemtime{$a} };
+ }
+ elsif ($params{sort} eq 'age') {
+ $f=sub { $pagectime{$b} <=> $pagectime{$a} };
+ }
+ else {
+ error sprintf(gettext("unknown sort type %s"), $params{sort});
+ }
+ @candidates = sort { &$f } @candidates;
+ }
+
+ @candidates=reverse(@candidates) if $params{reverse};
+
+ my @matches;
+ my $firstfail;
+ my $count=0;
+ foreach my $p (@candidates) {
+ my $r=$sub->($p, location => $page);
+ if ($r) {
+ push @matches, [$p, $r];
+ last if defined $params{num} && ++$count == $params{num};
+ }
+ elsif (! defined $firstfail) {
+ $firstfail=$r;
+ }
+ }
+
+ $depends{$page}{$pagespec} |= ($params{deptype} || $DEPEND_CONTENT);
+
+ my @ret;
+ if (@matches) {
+ # Add all influences from successful matches.
+ foreach my $m (@matches) {
+ push @ret, $m->[0];
+ my %i=$m->[1]->influences;
+ foreach my $i (keys %i) {
+ $depends_simple{$page}{lc $i} |= $i{$i};
+ }
+ }
+ }
+ elsif (defined $firstfail) {
+ # Add influences from one failure. (Which one should not
+ # matter; all should have the same influences.)
+ my %i=$firstfail->influences;
+ foreach my $i (keys %i) {
+ $depends_simple{$page}{lc $i} |= $i{$i};
+ }
+
+ error(sprintf(gettext("cannot match pages: %s"), $firstfail))
+ if $firstfail->isa("IkiWiki::ErrorReason");
+ }
+
+ return @ret;
+}
+
+sub deptype (@) {
+ my $deptype=0;
+ foreach my $type (@_) {
+ if ($type eq 'presence') {
+ $deptype |= $DEPEND_PRESENCE;
+ }
+ elsif ($type eq 'links') {
+ $deptype |= $DEPEND_LINKS;
+ }
+ elsif ($type eq 'content') {
+ $deptype |= $DEPEND_CONTENT;
+ }
+ }
+ return $deptype;
+}
+
+sub file_pruned ($;$) {
+ my $file=shift;
+ if (@_) {
+ require File::Spec;
+ $file=File::Spec->canonpath($file);
+ my $base=File::Spec->canonpath(shift);
+ return if $file eq $base;
+ $file =~ s#^\Q$base\E/+##;
+ }
+
+ my $regexp='('.join('|', @{$config{wiki_file_prune_regexps}}).')';
+ return $file =~ m/$regexp/;
+}
+
+sub define_gettext () {
+ # If translation is needed, redefine the gettext function to do it.
+ # Otherwise, it becomes a quick no-op.
+ no warnings 'redefine';
+ if ((exists $ENV{LANG} && length $ENV{LANG}) ||
+ (exists $ENV{LC_ALL} && length $ENV{LC_ALL}) ||
+ (exists $ENV{LC_MESSAGES} && length $ENV{LC_MESSAGES})) {
+ *gettext=sub {
+ my $gettext_obj=eval q{
+ use Locale::gettext q{textdomain};
+ Locale::gettext->domain('ikiwiki')
+ };
+
+ if ($gettext_obj) {
+ $gettext_obj->get(shift);
+ }
+ else {
+ return shift;
+ }
+ };
+ }
+ else {
+ *gettext=sub { return shift };
+ }
+}
+
+sub gettext {
+ define_gettext();
+ gettext(@_);
+}
+
+sub yesno ($) {
+ my $val=shift;
+
+ return (defined $val && (lc($val) eq gettext("yes") || lc($val) eq "yes" || $val eq "1"));
+}
+
+sub inject {
+ # Injects a new function into the symbol table to replace an
+ # exported function.
+ my %params=@_;
+
+ # This is deep ugly perl foo, beware.
+ no strict;
+ no warnings;
+ if (! defined $params{parent}) {
+ $params{parent}='::';
+ $params{old}=\&{$params{name}};
+ $params{name}=~s/.*:://;
+ }
+ my $parent=$params{parent};
+ foreach my $ns (grep /^\w+::/, keys %{$parent}) {
+ $ns = $params{parent} . $ns;
+ inject(%params, parent => $ns) unless $ns eq '::main::';
+ *{$ns . $params{name}} = $params{call}
+ if exists ${$ns}{$params{name}} &&
+ \&{${$ns}{$params{name}}} == $params{old};
+ }
+ use strict;
+ use warnings;
+}
+
+sub add_link ($$) {
+ my $page=shift;
+ my $link=shift;
+
+ push @{$links{$page}}, $link
+ unless grep { $_ eq $link } @{$links{$page}};
+}
+
+sub pagespec_translate ($) {
+ my $spec=shift;
+
+ # Convert spec to perl code.
+ my $code="";
+ my @data;
+ while ($spec=~m{
+ \s* # ignore whitespace
+ ( # 1: match a single word
+ \! # !
+ |
+ \( # (
+ |
+ \) # )
+ |
+ \w+\([^\)]*\) # command(params)
+ |
+ [^\s()]+ # any other text
+ )
+ \s* # ignore whitespace
+ }gx) {
+ my $word=$1;
+ if (lc $word eq 'and') {
+ $code.=' &';
+ }
+ elsif (lc $word eq 'or') {
+ $code.=' |';
+ }
+ elsif ($word eq "(" || $word eq ")" || $word eq "!") {
+ $code.=' '.$word;
+ }
+ elsif ($word =~ /^(\w+)\((.*)\)$/) {
+ if (exists $IkiWiki::PageSpec::{"match_$1"}) {
+ push @data, $2;
+ $code.="IkiWiki::PageSpec::match_$1(\$page, \$data[$#data], \@_)";
+ }
+ else {
+ push @data, qq{unknown function in pagespec "$word"};
+ $code.="IkiWiki::ErrorReason->new(\$data[$#data])";
+ }
+ }
+ else {
+ push @data, $word;
+ $code.=" IkiWiki::PageSpec::match_glob(\$page, \$data[$#data], \@_)";
+ }
+ }
+
+ if (! length $code) {
+ $code="IkiWiki::FailReason->new('empty pagespec')";
+ }
+
+ no warnings;
+ return eval 'sub { my $page=shift; '.$code.' }';
+}
+
+sub pagespec_match ($$;@) {
+ my $page=shift;
+ my $spec=shift;
+ my @params=@_;
+
+ # Backwards compatability with old calling convention.
+ if (@params == 1) {
+ unshift @params, 'location';
+ }
+
+ my $sub=pagespec_translate($spec);
+ return IkiWiki::ErrorReason->new("syntax error in pagespec \"$spec\"")
+ if $@ || ! defined $sub;
+ return $sub->($page, @params);
+}
+
+sub pagespec_match_list ($$;@) {
+ my $pages=shift;
+ my $spec=shift;
+ my @params=@_;
+
+ my $sub=pagespec_translate($spec);
+ error "syntax error in pagespec \"$spec\""
+ if $@ || ! defined $sub;
+
+ my @ret;
+ my $r;
+ foreach my $page (@$pages) {
+ $r=$sub->($page, @params);
+ push @ret, $page if $r;
+ }
+
+ if (! @ret && defined $r && $r->isa("IkiWiki::ErrorReason")) {
+ error(sprintf(gettext("cannot match pages: %s"), $r));
+ }
+ else {
+ return @ret;
+ }
+}
+
+sub pagespec_valid ($) {
+ my $spec=shift;
+
+ my $sub=pagespec_translate($spec);
+ return ! $@;
+}
+
+sub glob2re ($) {
+ my $re=quotemeta(shift);
+ $re=~s/\\\*/.*/g;
+ $re=~s/\\\?/./g;
+ return $re;
+}
+
+package IkiWiki::FailReason;
+
+use overload (
+ '""' => sub { $_[0][0] },
+ '0+' => sub { 0 },
+ '!' => sub { bless $_[0], 'IkiWiki::SuccessReason'},
+ '&' => sub { $_[0]->merge_influences($_[1]); $_[0] },
+ '|' => sub { $_[1]->merge_influences($_[0]); $_[1] },
+ fallback => 1,
+);
+
+our @ISA = 'IkiWiki::SuccessReason';
+
+package IkiWiki::SuccessReason;
+
+use overload (
+ '""' => sub { $_[0][0] },
+ '0+' => sub { 1 },
+ '!' => sub { bless $_[0], 'IkiWiki::FailReason'},
+ '&' => sub { $_[1]->merge_influences($_[0]); $_[1] },
+ '|' => sub { $_[0]->merge_influences($_[1]); $_[0] },
+ fallback => 1,
+);
+
+sub new {
+ my $class = shift;
+ my $value = shift;
+ return bless [$value, {@_}], $class;
+}
+
+sub influences {
+ my $this=shift;
+ if (! @_) {
+ return %{$this->[1]};
+ }
+ else {
+ $this->[1]={@_};
+ }
+}
+
+sub merge_influences {
+ my $this=shift;
+ my $other=shift;
+ foreach my $influence (keys %{$other->[1]}) {
+ $this->[1]{$influence} |= $other->[1]{$influence};
+ }
+}
+
+package IkiWiki::ErrorReason;
+
+our @ISA = 'IkiWiki::FailReason';
+
+package IkiWiki::PageSpec;
+
+sub derel ($$) {
+ my $path=shift;
+ my $from=shift;
+
+ if ($path =~ m!^\./!) {
+ $from=~s#/?[^/]+$## if defined $from;
+ $path=~s#^\./##;
+ $path="$from/$path" if length $from;
+ }
+
+ return $path;
+}
+
+sub match_glob ($$;@) {
+ my $page=shift;
+ my $glob=shift;
+ my %params=@_;
+
+ $glob=derel($glob, $params{location});
+
+ my $regexp=IkiWiki::glob2re($glob);
+ if ($page=~/^$regexp$/i) {
+ if (! IkiWiki::isinternal($page) || $params{internal}) {
+ return IkiWiki::SuccessReason->new("$glob matches $page");
+ }
+ else {
+ return IkiWiki::FailReason->new("$glob matches $page, but the page is an internal page");
+ }
+ }
+ else {
+ return IkiWiki::FailReason->new("$glob does not match $page");
+ }
+}
+
+sub match_internal ($$;@) {
+ return match_glob($_[0], $_[1], @_, internal => 1)
+}
+
+sub match_link ($$;@) {
+ my $page=shift;
+ my $link=lc(shift);
+ my %params=@_;
+
+ $link=derel($link, $params{location});
+ my $from=exists $params{location} ? $params{location} : '';
+
+ my $links = $IkiWiki::links{$page};
+ return IkiWiki::FailReason->new("$page has no links")
+ unless $links && @{$links};
+ my $bestlink = IkiWiki::bestlink($from, $link);
+ foreach my $p (@{$links}) {
+ if (length $bestlink) {
+ return IkiWiki::SuccessReason->new("$page links to $link", $page => $IkiWiki::DEPEND_LINKS)
+ if $bestlink eq IkiWiki::bestlink($page, $p);
+ }
+ else {
+ return IkiWiki::SuccessReason->new("$page links to page $p matching $link", $page => $IkiWiki::DEPEND_LINKS)
+ if match_glob($p, $link, %params);
+ my ($p_rel)=$p=~/^\/?(.*)/;
+ $link=~s/^\///;
+ return IkiWiki::SuccessReason->new("$page links to page $p_rel matching $link", $page => $IkiWiki::DEPEND_LINKS)
+ if match_glob($p_rel, $link, %params);
+ }
+ }
+ return IkiWiki::FailReason->new("$page does not link to $link");
+}
+
+sub match_backlink ($$;@) {
+ my $ret=match_link($_[1], $_[0], @_);
+ $ret->influences($_[1] => $IkiWiki::DEPEND_LINKS);
+ return $ret;
+}
+
+sub match_created_before ($$;@) {
+ my $page=shift;
+ my $testpage=shift;
+ my %params=@_;
+
+ $testpage=derel($testpage, $params{location});
+
+ if (exists $IkiWiki::pagectime{$testpage}) {
+ if ($IkiWiki::pagectime{$page} < $IkiWiki::pagectime{$testpage}) {
+ return IkiWiki::SuccessReason->new("$page created before $testpage", $testpage => $IkiWiki::DEPEND_PRESENCE);
+ }
+ else {
+ return IkiWiki::FailReason->new("$page not created before $testpage", $testpage => $IkiWiki::DEPEND_PRESENCE);
+ }
+ }
+ else {
+ return IkiWiki::ErrorReason->new("$testpage does not exist", $testpage => $IkiWiki::DEPEND_PRESENCE);
+ }
+}
+
+sub match_created_after ($$;@) {
+ my $page=shift;
+ my $testpage=shift;
+ my %params=@_;
+
+ $testpage=derel($testpage, $params{location});
+
+ if (exists $IkiWiki::pagectime{$testpage}) {
+ if ($IkiWiki::pagectime{$page} > $IkiWiki::pagectime{$testpage}) {
+ return IkiWiki::SuccessReason->new("$page created after $testpage", $testpage => $IkiWiki::DEPEND_PRESENCE);
+ }
+ else {
+ return IkiWiki::FailReason->new("$page not created after $testpage", $testpage => $IkiWiki::DEPEND_PRESENCE);
+ }
+ }
+ else {
+ return IkiWiki::ErrorReason->new("$testpage does not exist", $testpage => $IkiWiki::DEPEND_PRESENCE);
+ }
+}
+
+sub match_creation_day ($$;@) {
+ if ((gmtime($IkiWiki::pagectime{shift()}))[3] == shift) {
+ return IkiWiki::SuccessReason->new('creation_day matched');
+ }
+ else {
+ return IkiWiki::FailReason->new('creation_day did not match');
+ }
+}
+
+sub match_creation_month ($$;@) {
+ if ((gmtime($IkiWiki::pagectime{shift()}))[4] + 1 == shift) {
+ return IkiWiki::SuccessReason->new('creation_month matched');
+ }
+ else {
+ return IkiWiki::FailReason->new('creation_month did not match');
+ }
+}
+
+sub match_creation_year ($$;@) {
+ if ((gmtime($IkiWiki::pagectime{shift()}))[5] + 1900 == shift) {
+ return IkiWiki::SuccessReason->new('creation_year matched');
+ }
+ else {
+ return IkiWiki::FailReason->new('creation_year did not match');
+ }
+}
+
+sub match_user ($$;@) {
+ shift;
+ my $user=shift;
+ my %params=@_;
+
+ if (! exists $params{user}) {
+ return IkiWiki::ErrorReason->new("no user specified");
+ }
+
+ if (defined $params{user} && lc $params{user} eq lc $user) {
+ return IkiWiki::SuccessReason->new("user is $user");
+ }
+ elsif (! defined $params{user}) {
+ return IkiWiki::FailReason->new("not logged in");
+ }
+ else {
+ return IkiWiki::FailReason->new("user is $params{user}, not $user");
+ }
+}
+
+sub match_admin ($$;@) {
+ shift;
+ shift;
+ my %params=@_;
+
+ if (! exists $params{user}) {
+ return IkiWiki::ErrorReason->new("no user specified");
+ }
+
+ if (defined $params{user} && IkiWiki::is_admin($params{user})) {
+ return IkiWiki::SuccessReason->new("user is an admin");
+ }
+ elsif (! defined $params{user}) {
+ return IkiWiki::FailReason->new("not logged in");
+ }
+ else {
+ return IkiWiki::FailReason->new("user is not an admin");
+ }
+}
+
+sub match_ip ($$;@) {
+ shift;
+ my $ip=shift;
+ my %params=@_;
+
+ if (! exists $params{ip}) {
+ return IkiWiki::ErrorReason->new("no IP specified");
+ }
+
+ if (defined $params{ip} && lc $params{ip} eq lc $ip) {
+ return IkiWiki::SuccessReason->new("IP is $ip");
+ }
+ else {
+ return IkiWiki::FailReason->new("IP is $params{ip}, not $ip");
+ }
+}