File Coverage

lib/Kwiki/Keywords.pm

Criterion	Covered	Total	%
statement	1	3	33.3
branch			n/a
condition			n/a
subroutine	1	1	100.0
pod			n/a
total	2	4	50.0

package Kwiki::Keywords;
use Kwiki::Plugin '-Base';
use Kwiki::Installer '-base';

const class_id       => 'keywords';
const class_title    => 'Keywords';
const cgi_class      => 'Kwiki::CGI::Keywords';
const config_file    => 'keywords.yaml';

field keywords_directory => '-init' =>
    '$self->plugin_directory . "/keywords"';
field pages_directory => '-init' =>
    '$self->plugin_directory . "/pages"';

our $VERSION = '0.14';

sub init {
    super;
    return unless $self->is_in_cgi;
    io($self->keywords_directory)->mkdir;
    io($self->pages_directory)->mkdir;
}

sub register {
    my $registry = shift;
    $registry->add(hook => 'page:store', post => 'add_automatic_keywords');
    $registry->add(action => 'keyword_display');
    $registry->add(action => 'keyword_add');
    $registry->add(action => 'keyword_del');
    $registry->add(action => 'keyword_list');
    $registry->add(widget => 'keywords',
                   template => 'keywords_widget.html',
                   show_for => 'display',
               );
    $registry->add(widget => 'keywords_related',
                   template => 'keywords_related_widget.html',
                   show_for => 'keyword_display',
               );
    $registry->add(toolbar => 'keyword_list',
                   template => 'keyword_list_button.html'
               );
}

sub keywords_from_cgi {
    my @keywords = split /\s+/, $self->cgi->keyword;
    return \@keywords;
}

sub keyword_add {
    my $keywords = $self->keywords_from_cgi;
    my $page = $self->hub->pages->new_from_name($self->cgi->page_name);
    my $count = 1;
    for my $keyword (@$keywords) {
        next unless $keyword;
        die "'$keyword' contains illegal characters"
          unless $keyword =~ /^[\w\-]+$/;
        $self->add_keyword($page, $keyword);
        last if ++$count > 5;   # sanity limit
    }
    $self->redirect($page->uri);
}

sub keyword_del {
    my $keyword = $self->cgi->keyword;
    my $page = $self->hub->pages->new_from_name($self->cgi->page_name);
    $self->del_keyword($page, $keyword);
    $self->redirect($page->uri);
}

sub keyword_display {
    my $keywords = $self->keywords_from_cgi;
    my $pages    = $self->get_pages_for_keywords(@$keywords);
    $self->render_screen(
        screen_title => "Pages with keywords {@$keywords}",
        pages => $pages,
    )
}

sub keyword_list {
    my $keywords = $self->get_all_keywords;
    my $blog = $self->hub->have_plugin('blog');
    $self->template_process($self->screen_template,
        content_pane => 'keyword_list.html',
        screen_title => "All Keywords",
        keywords => $keywords,
        blog => $blog,
    );
}

sub get_all_keywords {
    my $io = io($self->keywords_directory);
    return [
        sort {lc($a) cmp lc($b)}
        grep {
           scalar(@{$self->get_pages_for_keyword($_)})
        }
        map {
            $_->filename
        } $io->all
    ];
}

sub get_pages_for_keywords {
    return $self->get_pages_for_keyword(@_) if @_ == 1;

    my %page;
    foreach my $keyword (@_) {
        foreach (@{ $self->get_pages_for_keyword($keyword) }) {
            my $title = $_->title;
            if ($page{$title}) { $page{$title}[1]++; next;  }
            else               { $page{$title} = [ $_, 1 ]; }
        }
    }
    return [ map { $_->[0] } grep { $_->[1] == @_ } values %page ];
}

sub get_pages_for_keyword {
    my $keyword = shift;
    my $io = io($self->keywords_directory . "/$keyword");
    my $pages = $io->exists
      ? [ map {
          $self->hub->pages->new_from_name($_->filename)
      } grep $_, $io->all ]
      : [];
    return $pages;
}

sub keywords_for_page {
    my $page = shift;
    my $io = io($self->pages_directory . "/$page");
    my $keywords = $io->exists
      ? [
            map { $_->filename } sort {
                $b->mtime <=> $a->mtime or
                lc("$a") cmp lc("$b")
            } $io->all
        ]
      : [];
    return $keywords;
}

sub keywords_for_current_page {
    my $page = $self->hub->pages->current->id;
    return $self->keywords_for_page($page);
}

sub get_related_keywords {
    my ($keywords) = @_;
    my $pages = $self->get_pages_for_keywords(@$keywords);

    my %relations;
    for (@$pages) {
        my $page_keywords = $self->keywords_for_page($_->id);
        for my $related (@$page_keywords) {
            next if grep { $related eq $_ } @$keywords;
            $relations{$related}++
        }
    }
    return [ keys %relations ];
}

sub add_automatic_keywords {
    my $hook = pop;
    my $pages = $self; # we're running in the class with class id page
    $self = $self->hub->keywords; # move ourselves into this class
    return if $self->hub->config->keywords_no_automatic;
    $self->add_author_keyword;
}

sub add_author_keyword {
    my $author = $self->hub->users->current->name;
    my $page = $self->hub->pages->current;
    $self->add_keyword($page, $author) if $author;
}

sub add_keyword {
    my $page = shift;
    my $keyword = shift;
    return unless $page->is_writable;
    my $id = $page->id;
    io($self->keywords_directory . "/$keyword/$id")->assert->touch;
    io($self->pages_directory . "/$id/$keyword")->assert->touch;
}

sub del_keyword {
    my $page = shift;
    my $keyword = shift;
    return unless $page->is_writable;
    my $id = $page->id;
    io($self->keywords_directory . "/$keyword/$id")->unlink;
    io($self->pages_directory . "/$id/$keyword")->unlink;
}

package Kwiki::CGI::Keywords;
use Kwiki::CGI -Base;

cgi 'keyword';
cgi 'page_name';

package Kwiki::Keywords;

__DATA__