summaryrefslogtreecommitdiff
path: root/IkiWiki.pm
blob: 9a7b4fe911a284f7a11dfc19060ffbddef2b2401 (plain)
  1. #!/usr/bin/perl
  2. package IkiWiki;
  3. use warnings;
  4. use strict;
  5. use File::Spec;
  6. use HTML::Template;
  7. use vars qw{%config %links %oldlinks %oldpagemtime %pagectime
  8. %renderedfiles %pagesources %depends %hooks};
  9. sub checkconfig () { #{{{
  10. if ($config{cgi} && ! length $config{url}) {
  11. error("Must specify url to wiki with --url when using --cgi\n");
  12. }
  13. if ($config{rss} && ! length $config{url}) {
  14. error("Must specify url to wiki with --url when using --rss\n");
  15. }
  16. if ($config{hyperestraier} && ! length $config{url}) {
  17. error("Must specify --url when using --hyperestraier\n");
  18. }
  19. $config{wikistatedir}="$config{srcdir}/.ikiwiki"
  20. unless exists $config{wikistatedir};
  21. if ($config{rcs}) {
  22. eval qq{require IkiWiki::Rcs::$config{rcs}};
  23. if ($@) {
  24. error("Failed to load RCS module IkiWiki::Rcs::$config{rcs}: $@");
  25. }
  26. }
  27. else {
  28. require IkiWiki::Rcs::Stub;
  29. }
  30. foreach my $plugin (@{$config{plugin}}) {
  31. my $mod="IkiWiki::Plugin::".possibly_foolish_untaint($plugin);
  32. eval qq{use $mod};
  33. if ($@) {
  34. error("Failed to load plugin $mod: $@");
  35. }
  36. }
  37. } #}}}
  38. sub error ($) { #{{{
  39. if ($config{cgi}) {
  40. print "Content-type: text/html\n\n";
  41. print misctemplate("Error", "<p>Error: @_</p>");
  42. }
  43. die @_;
  44. } #}}}
  45. sub debug ($) { #{{{
  46. return unless $config{verbose};
  47. if (! $config{cgi}) {
  48. print "@_\n";
  49. }
  50. else {
  51. print STDERR "@_\n";
  52. }
  53. } #}}}
  54. sub possibly_foolish_untaint ($) { #{{{
  55. my $tainted=shift;
  56. my ($untainted)=$tainted=~/(.*)/;
  57. return $untainted;
  58. } #}}}
  59. sub basename ($) { #{{{
  60. my $file=shift;
  61. $file=~s!.*/+!!;
  62. return $file;
  63. } #}}}
  64. sub dirname ($) { #{{{
  65. my $file=shift;
  66. $file=~s!/*[^/]+$!!;
  67. return $file;
  68. } #}}}
  69. sub pagetype ($) { #{{{
  70. my $page=shift;
  71. if ($page =~ /\.mdwn$/) {
  72. return ".mdwn";
  73. }
  74. else {
  75. return "unknown";
  76. }
  77. } #}}}
  78. sub pagename ($) { #{{{
  79. my $file=shift;
  80. my $type=pagetype($file);
  81. my $page=$file;
  82. $page=~s/\Q$type\E*$// unless $type eq 'unknown';
  83. return $page;
  84. } #}}}
  85. sub htmlpage ($) { #{{{
  86. my $page=shift;
  87. return $page.".html";
  88. } #}}}
  89. sub srcfile ($) { #{{{
  90. my $file=shift;
  91. return "$config{srcdir}/$file" if -e "$config{srcdir}/$file";
  92. return "$config{underlaydir}/$file" if -e "$config{underlaydir}/$file";
  93. error("internal error: $file cannot be found");
  94. } #}}}
  95. sub readfile ($;$) { #{{{
  96. my $file=shift;
  97. my $binary=shift;
  98. if (-l $file) {
  99. error("cannot read a symlink ($file)");
  100. }
  101. local $/=undef;
  102. open (IN, $file) || error("failed to read $file: $!");
  103. binmode(IN) if $binary;
  104. my $ret=<IN>;
  105. close IN;
  106. return $ret;
  107. } #}}}
  108. sub writefile ($$$;$) { #{{{
  109. my $file=shift; # can include subdirs
  110. my $destdir=shift; # directory to put file in
  111. my $content=shift;
  112. my $binary=shift;
  113. my $test=$file;
  114. while (length $test) {
  115. if (-l "$destdir/$test") {
  116. error("cannot write to a symlink ($test)");
  117. }
  118. $test=dirname($test);
  119. }
  120. my $dir=dirname("$destdir/$file");
  121. if (! -d $dir) {
  122. my $d="";
  123. foreach my $s (split(m!/+!, $dir)) {
  124. $d.="$s/";
  125. if (! -d $d) {
  126. mkdir($d) || error("failed to create directory $d: $!");
  127. }
  128. }
  129. }
  130. open (OUT, ">$destdir/$file") || error("failed to write $destdir/$file: $!");
  131. binmode(OUT) if $binary;
  132. print OUT $content;
  133. close OUT;
  134. } #}}}
  135. sub bestlink ($$) { #{{{
  136. # Given a page and the text of a link on the page, determine which
  137. # existing page that link best points to. Prefers pages under a
  138. # subdirectory with the same name as the source page, failing that
  139. # goes down the directory tree to the base looking for matching
  140. # pages.
  141. my $page=shift;
  142. my $link=lc(shift);
  143. my $cwd=$page;
  144. do {
  145. my $l=$cwd;
  146. $l.="/" if length $l;
  147. $l.=$link;
  148. if (exists $links{$l}) {
  149. #debug("for $page, \"$link\", use $l");
  150. return $l;
  151. }
  152. } while $cwd=~s!/?[^/]+$!!;
  153. #print STDERR "warning: page $page, broken link: $link\n";
  154. return "";
  155. } #}}}
  156. sub isinlinableimage ($) { #{{{
  157. my $file=shift;
  158. $file=~/\.(png|gif|jpg|jpeg)$/i;
  159. } #}}}
  160. sub pagetitle ($) { #{{{
  161. my $page=shift;
  162. $page=~s/__(\d+)__/&#$1;/g;
  163. $page=~y/_/ /;
  164. return $page;
  165. } #}}}
  166. sub titlepage ($) { #{{{
  167. my $title=shift;
  168. $title=~y/ /_/;
  169. $title=~s/([^-[:alnum:]_:+\/.])/"__".ord($1)."__"/eg;
  170. return $title;
  171. } #}}}
  172. sub cgiurl (@) { #{{{
  173. my %params=@_;
  174. return $config{cgiurl}."?".join("&amp;", map "$_=$params{$_}", keys %params);
  175. } #}}}
  176. sub styleurl (;$) { #{{{
  177. my $page=shift;
  178. return "$config{url}/style.css" if ! defined $page;
  179. $page=~s/[^\/]+$//;
  180. $page=~s/[^\/]+\//..\//g;
  181. return $page."style.css";
  182. } #}}}
  183. sub htmllink ($$;$$$) { #{{{
  184. my $page=shift;
  185. my $link=shift;
  186. my $noimageinline=shift; # don't turn links into inline html images
  187. my $forcesubpage=shift; # force a link to a subpage
  188. my $linktext=shift; # set to force the link text to something
  189. my $bestlink;
  190. if (! $forcesubpage) {
  191. $bestlink=bestlink($page, $link);
  192. }
  193. else {
  194. $bestlink="$page/".lc($link);
  195. }
  196. $linktext=pagetitle(basename($link)) unless defined $linktext;
  197. return $linktext if length $bestlink && $page eq $bestlink;
  198. # TODO BUG: %renderedfiles may not have it, if the linked to page
  199. # was also added and isn't yet rendered! Note that this bug is
  200. # masked by the bug mentioned below that makes all new files
  201. # be rendered twice.
  202. if (! grep { $_ eq $bestlink } values %renderedfiles) {
  203. $bestlink=htmlpage($bestlink);
  204. }
  205. if (! grep { $_ eq $bestlink } values %renderedfiles) {
  206. return "<span><a href=\"".
  207. cgiurl(do => "create", page => $link, from =>$page).
  208. "\">?</a>$linktext</span>"
  209. }
  210. $bestlink=File::Spec->abs2rel($bestlink, dirname($page));
  211. if (! $noimageinline && isinlinableimage($bestlink)) {
  212. return "<img src=\"$bestlink\" alt=\"$linktext\" />";
  213. }
  214. return "<a href=\"$bestlink\">$linktext</a>";
  215. } #}}}
  216. sub indexlink () { #{{{
  217. return "<a href=\"$config{url}\">$config{wikiname}</a>";
  218. } #}}}
  219. sub lockwiki () { #{{{
  220. # Take an exclusive lock on the wiki to prevent multiple concurrent
  221. # run issues. The lock will be dropped on program exit.
  222. if (! -d $config{wikistatedir}) {
  223. mkdir($config{wikistatedir});
  224. }
  225. open(WIKILOCK, ">$config{wikistatedir}/lockfile") ||
  226. error ("cannot write to $config{wikistatedir}/lockfile: $!");
  227. if (! flock(WIKILOCK, 2 | 4)) {
  228. debug("wiki seems to be locked, waiting for lock");
  229. my $wait=600; # arbitrary, but don't hang forever to
  230. # prevent process pileup
  231. for (1..600) {
  232. return if flock(WIKILOCK, 2 | 4);
  233. sleep 1;
  234. }
  235. error("wiki is locked; waited $wait seconds without lock being freed (possible stuck process or stale lock?)");
  236. }
  237. } #}}}
  238. sub unlockwiki () { #{{{
  239. close WIKILOCK;
  240. } #}}}
  241. sub loadindex () { #{{{
  242. open (IN, "$config{wikistatedir}/index") || return;
  243. while (<IN>) {
  244. $_=possibly_foolish_untaint($_);
  245. chomp;
  246. my %items;
  247. $items{link}=[];
  248. foreach my $i (split(/ /, $_)) {
  249. my ($item, $val)=split(/=/, $i, 2);
  250. push @{$items{$item}}, $val;
  251. }
  252. next unless exists $items{src}; # skip bad lines for now
  253. my $page=pagename($items{src}[0]);
  254. if (! $config{rebuild}) {
  255. $pagesources{$page}=$items{src}[0];
  256. $oldpagemtime{$page}=$items{mtime}[0];
  257. $oldlinks{$page}=[@{$items{link}}];
  258. $links{$page}=[@{$items{link}}];
  259. $depends{$page}=join(" ", @{$items{depends}})
  260. if exists $items{depends};
  261. $renderedfiles{$page}=$items{dest}[0];
  262. }
  263. $pagectime{$page}=$items{ctime}[0];
  264. }
  265. close IN;
  266. } #}}}
  267. sub saveindex () { #{{{
  268. if (! -d $config{wikistatedir}) {
  269. mkdir($config{wikistatedir});
  270. }
  271. open (OUT, ">$config{wikistatedir}/index") ||
  272. error("cannot write to $config{wikistatedir}/index: $!");
  273. foreach my $page (keys %oldpagemtime) {
  274. next unless $oldpagemtime{$page};
  275. my $line="mtime=$oldpagemtime{$page} ".
  276. "ctime=$pagectime{$page} ".
  277. "src=$pagesources{$page} ".
  278. "dest=$renderedfiles{$page}";
  279. $line.=" link=$_" foreach @{$links{$page}};
  280. if (exists $depends{$page}) {
  281. $line.=" depends=$_" foreach split " ", $depends{$page};
  282. }
  283. print OUT $line."\n";
  284. }
  285. close OUT;
  286. } #}}}
  287. sub misctemplate ($$) { #{{{
  288. my $title=shift;
  289. my $pagebody=shift;
  290. my $template=HTML::Template->new(
  291. filename => "$config{templatedir}/misc.tmpl"
  292. );
  293. $template->param(
  294. title => $title,
  295. indexlink => indexlink(),
  296. wikiname => $config{wikiname},
  297. pagebody => $pagebody,
  298. styleurl => styleurl(),
  299. baseurl => "$config{url}/",
  300. );
  301. return $template->output;
  302. }#}}}
  303. sub glob_match ($$) { #{{{
  304. my $page=shift;
  305. my $glob=shift;
  306. # turn glob into safe regexp
  307. $glob=quotemeta($glob);
  308. $glob=~s/\\\*/.*/g;
  309. $glob=~s/\\\?/./g;
  310. $glob=~s!\\/!/!g;
  311. $page=~/^$glob$/i;
  312. } #}}}
  313. sub globlist_match ($$) { #{{{
  314. my $page=shift;
  315. my @globlist=split(" ", shift);
  316. # check any negated globs first
  317. foreach my $glob (@globlist) {
  318. return 0 if $glob=~/^!(.*)/ && glob_match($page, $1);
  319. }
  320. foreach my $glob (@globlist) {
  321. return 1 if glob_match($page, $glob);
  322. }
  323. return 0;
  324. } #}}}
  325. sub hook (@) { # {{{
  326. my %param=@_;
  327. if (! exists $param{type} || ! ref $param{call} || ! exists $param{id}) {
  328. error "hook requires type, call, and id parameters";
  329. }
  330. $hooks{$param{type}}{$param{id}}=\%param;
  331. } # }}}
  332. 1