IkiWiki/Plugin/pedigree.pm

   1 #!/usr/bin/perl
   2 # -*- cperl-indent-level: 8; -*-
   3 # Ikiwiki pedigree plugin.
   4 package IkiWiki::Plugin::pedigree;
   5
   6 use warnings;
   7 use strict;
   8 use IkiWiki 2.00;
   9
  10 sub import { #{{{
  11         hook(type => "pagetemplate", id => "pedigree", call => \&pagetemplate);
  12 } # }}}
  13
  14 sub pedigree ($) { #{{{
  15         my $page=shift;
  16
  17         my @ret;
  18         my $path="";
  19         my $title=$config{wikiname};
  20         my $i=0;
  21
  22         my @pagepath=(split("/", $page));
  23         my $pagedepth=@pagepath;
  24         foreach my $dir (@pagepath) {
  25                 next if $dir eq 'index';
  26                 push @ret, {
  27                             url => urlto($path, $page),
  28                             page => $title,
  29                             absdepth => $i,
  30                             distance => ($pagedepth - $i),
  31                             is_root => ($i eq 0),
  32                             is_second_ancestor => ($i eq 1),
  33                             is_grand_mother => ($i eq ($pagedepth - 2)),
  34                             is_mother => ($i eq ($pagedepth - 1)),
  35                            };
  36                 $path.="/".$dir;
  37                 $title=IkiWiki::pagetitle($dir);
  38                 $i++;
  39         }
  40         return @ret;
  41 } #}}}
  42
  43 sub forget_oldest ($@) { #{{{
  44         my $offset=shift;
  45         my @pedigree=@_;
  46         my @ret;
  47         my $parent;
  48         unless ($offset ge scalar(@pedigree)) {
  49                 for (my $i=0; $i < $offset; $i++) {
  50                         shift @pedigree;
  51                 }
  52                 while (@pedigree) {
  53                         # Doing so does not modify the original @pedigree, we've
  54                         # got our own copy of its "content" (i.e. a pile of
  55                         # references to hashes)...
  56                         $parent=shift @pedigree;
  57                         # ... but we have no copy of the referenced hashes, so we
  58                         # actually are modifying them in-place, which
  59                         # means the second (and following) calls to
  60                         # this function overwrite the previous one's
  61                         # reldepth values => known bug if PEDIGREE_BUT_ROOT and
  62                         # PEDIGREE_BUT_TWO_OLDEST are used in the same template
  63                         $parent->{reldepth}=($parent->{absdepth} - $offset);
  64                         push @ret, $parent;
  65                 }
  66         }
  67         return @ret;
  68 } #}}}
  69
  70 sub pagetemplate (@) { #{{{
  71         my %params=@_;
  72         my $page=$params{page};
  73         my $template=$params{template};
  74
  75         my @pedigree=pedigree($page)
  76           if ($template->query(name => "pedigree")
  77               or $template->query(name => "pedigree_but_root")
  78               or $template->query(name => "pedigree_but_two_oldest")
  79              );
  80
  81         $template->param(pedigree => \@pedigree)
  82           if ($template->query(name => "pedigree"));
  83         $template->param(pedigree_but_root => [forget_oldest(1, @pedigree)])
  84           if ($template->query(name => "pedigree_but_root"));
  85         $template->param(pedigree_but_two_oldest => [forget_oldest(2, @pedigree)])
  86           if ($template->query(name => "pedigree_but_two_oldest"));
  87
  88 } # }}}
  89
  90 1