diff options
Diffstat (limited to 'ikiwiki')
| -rwxr-xr-x | ikiwiki | 391 |
1 files changed, 1 insertions, 390 deletions
@@ -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", "<p>Error: @_</p>"); - } - 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=<IN>; - 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 "<span><a href=\"". - cgiurl(do => "create", page => $link, from =>$page). - "\">?</a>$linktext</span>" - } - - $bestlink=File::Spec->abs2rel($bestlink, dirname($page)); - - if (! $noimageinline && isinlinableimage($bestlink)) { - return "<img src=\"$bestlink\" alt=\"$linktext\" />"; - } - return "<a href=\"$bestlink\">$linktext</a>"; -} #}}} - -sub indexlink () { #{{{ - return "<a href=\"$config{url}\">$config{wikiname}</a>"; -} #}}} - -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 (<IN>) { - $_=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(); |