root/tagwire/tags/0.23/tagwire.pl

# Tagwire Plugin (aka AllKeywords Plugin)
# a plugin for listing and handling "tags"
#
# $Id$
#
# This software is provided as-is. You may use it for commercial or 
# personal use. If you distribute it, please keep this notice intact.
#
# Copyright (c) 2005 Hirotaka Ogawa

package MT::Plugin::Tagwire;
use strict;
use MT::Template::Context;
use MT::Request;

# DEBUG
my $FORCE_PD_REFRESH = 0;
my $ENABLE_PD_INDEXES = 1;
my $ENABLE_REQ_CACHE = 1;

my $plugin;
eval {
    require MT::Plugin;
    $plugin = new MT::Plugin({
        name => 'Tagwire Plugin',
        description => 'A plugin for listing and handling blog-wide tags and entry tags.',
        doc_link => 'http://as-is.net/hacks/2005/06/tagwire_plugin.html',
        author_name => 'Hirotaka Ogawa',
        author_link => 'http://profile.typekey.com/ogawa/',
        version => '0.23'
        });
    MT->add_plugin($plugin);
};

if (MT->can('add_callback')) {
    my $mt = MT->instance;
    MT->add_callback((ref $mt eq 'MT::App::CMS' ? 'AppPostEntrySave' : 'MT::Entry::post_save'),
                     10, $plugin, \&update_pd_indexes);
}

sub update_pd_indexes {
    return unless $ENABLE_PD_INDEXES && $plugin;
    my ($eh, $app, $entry) = @_;
    require MT::Entry;
    my $blog_id = $entry->blog_id;
    require MT::PluginData;
    my $pd = MT::PluginData->load({ plugin => $plugin->name,
                                    key => $blog_id });
    my (%eindex, %tindex);
    my $data;
    if (!$pd || $FORCE_PD_REFRESH) {
        if (!$pd) {
            $pd = new MT::PluginData();
            $pd->plugin($plugin->name);
            $pd->key($blog_id);
        }
        $data = $pd->data() || {};
        my $iter = MT::Entry->load_iter({ blog_id => $blog_id,
                                          status => MT::Entry::RELEASE() });
        while (my $e = $iter->()) {
            my @tags = split_tags($e->keywords, 1) or next;
            $eindex{$e->id} = { tags => \@tags,
                                created_on => $e->created_on };
        }
    } else {
        $data = $pd->data() || {};
        my $entry_id = $entry->id;
        %eindex = %{$data->{eindex}};
        delete $eindex{$entry_id} if exists $eindex{$entry_id};
        if ($entry->status == MT::Entry::RELEASE()) {
            my @tags = split_tags($entry->keywords, 1);
            $eindex{$entry_id} = { tags => \@tags,
                                   created_on => $entry->created_on };
        }
    }
    foreach my $eid (keys %eindex) {
        map { push @{$tindex{$_}}, $eid } @{$eindex{$eid}->{tags}};
    }
    $data->{eindex} = \%eindex;
    $data->{tindex} = \%tindex;
    $pd->data($data);
    $pd->save or die $pd->errstr;
    if ($ENABLE_REQ_CACHE) {
        my $r = MT::Request->instance;
        my $cname = 'Tagwire::Cache::' . $blog_id;
        $r->cache($cname, undef);
    }
}

MT::Template::Context->add_container_tag('Tags' => \&tags);
MT::Template::Context->add_container_tag('EntryTags' => \&entry_tags);
MT::Template::Context->add_tag('Tag' => \&tag);
MT::Template::Context->add_tag('TagCount' => \&tag_count);
MT::Template::Context->add_tag('TagsTotal' => \&tags_total);
MT::Template::Context->add_tag('TagsTotalSum' => \&tags_total_sum);
MT::Template::Context->add_container_tag('EntriesWithTags' => \&entries);
MT::Template::Context->add_container_tag('MostRelatedEntries' => \&most_related_entries);
MT::Template::Context->add_global_filter('encode_urlplus' => \&encode_urlplus);

# For compatibility (this plugin was formerly named 'AllKeywords')
MT::Template::Context->add_container_tag('AllKeywords' => \&tags);
MT::Template::Context->add_container_tag('EntryAllKeywords' => \&entry_tags);
MT::Template::Context->add_tag('AllKeyword' => \&tag);
MT::Template::Context->add_tag('AllKeywordCount' => \&tag_count);
MT::Template::Context->add_tag('AllKeywordsTotal' => \&tags_total);
MT::Template::Context->add_tag('AllKeywordsTotalSum' => \&tags_total_sum);
MT::Template::Context->add_container_tag('EntriesWithKeywords' => \&entries);

sub split_args {
    my ($string, $delimiter, $case_sensitive) = @_;
    return unless $string;
    my @tags;
    $string =~ s/(^\s+|\s+$)//g;
    $string = lc $string unless $case_sensitive;

    return split(/\s+/, $string) unless $delimiter;

    foreach my $tag (split($delimiter, $string)) {
        $tag =~ s/(^\s+|\s+$)//g;
        push @tags, $tag if $tag;
    }
    @tags;
}

sub split_tags {
    my ($string, $case_sensitive) = @_;
    return unless $string;
    my @tags;
    $string =~ s/(^\s+|\s+$)//g;
    $string = lc $string unless $case_sensitive;
#    $string =~ s/\[[^[]+\]//g; # uncomment this to discard [short title]

    if ($string =~ m/[;,|]/) {
        # tags separated by non-whitespaces
        while ($string =~ m/(\[[^]]+\]|"[^"]+"|'[^']+'|[^;,|]+)/g) {
            my $tag = $1;
            $tag =~ s/(^[\["'\s;,|]+|[\]"'\s;,|]+$)//g;
            push @tags, $tag if $tag;
        }
    } else {
        # tags separated by whitespaces
        while ($string =~ m/(\[[^]]+\]|"[^"]+"|'[^']+'|[^\s]+)/g) {
            my $tag = $1;
            $tag =~ s/(^[\["'\s]+|[\]"'\s]+$)//g;
            push @tags, $tag if $tag;
        }
    }
    @tags;
}

sub get_pd_indexes {
    return unless $ENABLE_PD_INDEXES && $plugin;
    my $blog_id = $_[0] or return;
    my ($r, $cname);
    if ($ENABLE_REQ_CACHE) {
        $r = MT::Request->instance;
        $cname = 'Tagwire::Cache::' . $blog_id;
        return $r->cache($cname) if defined $r->cache($cname);
        $r->cache($cname, undef);
    }
    my $data;
    eval {
        require MT::PluginData;
        my $pd = MT::PluginData->load({ plugin => $plugin->name,
                                        key => $blog_id });
        $data = $pd->data() if $pd;
    };
    $r->cache($cname, $data) if $ENABLE_REQ_CACHE && $data;
    $data;
}

sub get_db_indexes {
    my $blog_id = $_[0] or return;
    my ($r, $cname);
    if ($ENABLE_REQ_CACHE) {
        $r = MT::Request->instance;
        $cname = 'Tagwire::Cache::' . $blog_id;
        return $r->cache($cname) if defined $r->cache($cname);
        $r->cache($cname, undef);
    }
    my $data;
    my (%eindex, %tindex);
    my $iter = MT::Entry->load_iter({ blog_id => $blog_id,
                                      status => MT::Entry::RELEASE() });
    while (my $e = $iter->()) {
        my @tags = split_tags($e->keywords, 1) or next;
        $eindex{$e->id} = { tags => \@tags,
                            created_on => $e->created_on };
    }
    foreach my $eid (keys %eindex) {
        map { push @{$tindex{$_}}, $eid } @{$eindex{$eid}->{tags}};
    }
    $data->{eindex} = \%eindex;
    $data->{tindex} = \%tindex;
    $r->cache($cname, $data) if $ENABLE_REQ_CACHE;
    $data;
}

sub tags {
    my ($ctx, $args, $cond) = @_;

    # sort_by (tag/tag-case/count, default = tag)
    my $sort_by = $args->{sort_by} || 'tag';
    # sort_order (ascend/descend, default = ascend)
    my $sort_order = $args->{sort_order} || 'ascend';
    # lastn (default = 0, no cutoff)
    my $lastn = $args->{lastn} || 0;
    # case_sensitive (0/1, default = 1)
    my $case_sensitive = defined $args->{case_sensitive} ?
        $args->{case_sensitive} : 1;

    my $blog_id = $ctx->stash('blog_id');
    my %tags = ();

    my $data = get_pd_indexes($blog_id) || get_db_indexes($blog_id)
        or return '';
    my %tindex = %{$data->{tindex}};
    if ($case_sensitive) {
        map { $tags{$_} = scalar(@{$tindex{$_}}) } keys %tindex;
    } else {
        map { $tags{lc $_} += scalar(@{$tindex{$_}}) } keys %tindex;
    }

    my @list;
    if ($sort_by eq 'tag' || $sort_by eq 'keyword' ) {
        @list = $sort_order eq 'ascend' ?
            sort { lc $a cmp lc $b } keys %tags :
            sort { lc $b cmp lc $a } keys %tags;
    } elsif ($sort_by eq 'tag-case' || $sort_by eq 'keyword-case') {
        @list = $sort_order eq 'ascend' ?
            sort keys %tags :
            sort reverse keys %tags;
    } else {
        @list = $sort_order eq 'ascend' ?
            sort { $tags{$a} <=> $tags{$b} } keys %tags :
            sort { $tags{$b} <=> $tags{$a} } keys %tags;
    }

    $ctx->stash('Tagwire::tags_total', scalar @list);

    my $total_sum = 0;
    foreach (@list) {
        $total_sum += $tags{$_};
    }
    $ctx->stash('Tagwire::tags_total_sum', $total_sum);

    my @res;
    my $builder = $ctx->stash('builder');
    my $tokens = $ctx->stash('tokens');
    my $i = 0;
    foreach (@list) {
        last if $lastn && $i >= $lastn;
        $ctx->stash('Tagwire::tag', $case_sensitive ? $_ : ucfirst $_);
        $ctx->stash('Tagwire::tag_count', $tags{$_});
        defined(my $out = $builder->build($ctx, $tokens))
            or return $ctx->error($ctx->errstr);
        push @res, $out;
        $i++;
    }
    my $glue = $args->{glue} || '';
    join $glue, @res;
}

sub entry_tags {
    my ($ctx, $args, $cond) = @_;
    my $e = $ctx->stash('entry')
        or return $ctx->_no_entry_error('MT' . $ctx->stash('tag'));
    return '' unless $e->keywords;

    # case_sensitive (0/1, default = 1)
    my $case_sensitive = defined $args->{case_sensitive} ?
        $args->{case_sensitive} : 1;

    my @tags = split_tags($e->keywords, $case_sensitive);
    my $total = scalar(@tags);
    $ctx->stash('Tagwire::tags_total', $total);
    $ctx->stash('Tagwire::tags_total_sum', $total);

    my @res;
    my $builder = $ctx->stash('builder');
    my $tokens = $ctx->stash('tokens');
    foreach (@tags) {
        $ctx->stash('Tagwire::tag', $case_sensitive ? $_ : ucfirst $_);
        $ctx->stash('Tagwire::tag_count', 1);
        defined(my $out = $builder->build($ctx, $tokens))
            or return $ctx->error($ctx->errstr);
        push @res, $out;
    }
    my $glue = $args->{glue} || '';
    join $glue, @res;
}

sub tag {
    $_[0]->stash('Tagwire::tag');
}

sub tag_count {
    $_[0]->stash('Tagwire::tag_count');
}

sub tags_total {
    $_[0]->stash('Tagwire::tags_total');
}

sub tags_total_sum {
    $_[0]->stash('Tagwire::tags_total_sum');
}

sub entries {
    my ($ctx, $args, $cond) = @_;

    # tags(keywords) (REQUIRED)
    my $search = $args->{tags} || $args->{keywords} or return '';
    # delimiter for "tags" argument (default = space characters)
    my $delimiter = $args->{delimiter} || '';
    # case_sensitive (0/1, default = 1)
    my $case_sensitive = defined $args->{case_sensitive} ?
        $args->{case_sensitive} : 1;
    # sort_by (created_on, default = created_on)
    my $sort_by = $args->{sort_by} || 'created_on';
    # sort_order (ascend/descend, default = descend)
    my $sort_order = $args->{sort_order} || 'descend';
    # lastn (default = 0, no cutoff)
    my $lastn = $args->{lastn} || 0;

    my @patterns = split_args($search, $delimiter, $case_sensitive)
        or return '';

    my $blog_id = $ctx->stash('blog_id');
    my @entries;

    my $data = get_pd_indexes($blog_id) || get_db_indexes($blog_id)
        or return '';
    my %tindex = %{$data->{tindex}};
    my %eindex = %{$data->{eindex}};
    my %match;
    if ($case_sensitive) {
        foreach my $tag (@patterns) {
            foreach my $eid (@{$tindex{$tag}}) {
                $match{$eid} = exists $match{$eid} ? $match{$eid} + 1 : 1;
            }
        }
    } else {
        foreach my $tag (@patterns) {
            foreach my $mtag (grep { lc $_ eq $tag } keys %tindex) {
                foreach my $eid (@{$tindex{$mtag}}) {
                    $match{$eid} = exists $match{$eid} ? $match{$eid} + 1 : 1;
                }
            }
        }
    }
    my $count = scalar @patterns;
    my @eids = grep { $match{$_} == $count } keys %match or return;
    @eids = sort { $eindex{$b}->{created_on} <=> $eindex{$a}->{created_on} } @eids;
    @eids = $sort_order eq 'descend' ?
        sort { $eindex{$b}->{created_on} <=> $eindex{$a}->{created_on} } @eids :
        sort { $eindex{$a}->{created_on} <=> $eindex{$b}->{created_on} } @eids;
    splice(@eids, $lastn) if $lastn && (scalar @eids > $lastn);
    require MT::Entry;
    map { push @entries, MT::Entry->load($_) } @eids;

    my $res = '';
    my $tokens = $ctx->stash('tokens');
    my $builder = $ctx->stash('builder');
    my $i = 0;
    for my $e (@entries) {
        local $ctx->{__stash}{entry} = $e;
        local $ctx->{current_timestamp} = $e->created_on;
        local $ctx->{modification_timestamp} = $e->modified_on;
        my $out = $builder->build($ctx, $tokens, {
            %$cond,
            EntryIfExtended => $e->text_more ? 1 : 0,
            EntryIfAllowComments => $e->allow_comments,
            EntryIfCommentsOpen => $e->allow_comments && $e->allow_comments eq '1',
            EntryIfAllowPings => $e->allow_pings,
            EntriesHeader => !$i,
            EntriesFooter => !defined $entries[$i+1]
            });
        return $ctx->error($ctx->errstr) unless defined $out;
        $res .= $out;
        $i++;
    }
    $res;
}

sub most_related_entries {
    my ($ctx, $args, $cond) = @_;
    my $entry = $ctx->stash('entry')
        or return $ctx->_no_entry_error('MT' . $ctx->stash('tag'));
    return '' unless $entry->keywords;

    # case_sensitive (0/1, default = 1)
    my $case_sensitive = defined $args->{case_sensitive} ?
        $args->{case_sensitive} : 1;
    # sort_order (ascend/descend, default = descend)
    my $sort_order = $args->{sort_order} || 'descend';
    # lastn (default = 0, no cutoff)
    my $lastn = $args->{lastn} || 0;

    my @patterns = split_tags($entry->keywords, $case_sensitive)
        or return '';

    my $blog_id = $ctx->stash('blog_id');
    my @entries;

    my $data = get_pd_indexes($blog_id) || get_db_indexes($blog_id)
        or return '';
    my %tindex = %{$data->{tindex}};
    my %eindex = %{$data->{eindex}};
    my %match;
    if ($case_sensitive) {
        foreach my $tag (@patterns) {
            foreach my $eid (@{$tindex{$tag}}) {
                next if $eid == $entry->id;
                $match{$eid} = exists $match{$eid} ? $match{$eid} + 1 : 1;
            }
        }
    } else {
        foreach my $tag (@patterns) {
            foreach my $mtag (grep { lc $_ eq $tag } keys %tindex) {
                foreach my $eid (@{$tindex{$mtag}}) {
                    next if $eid == $entry->id;
                    $match{$eid} = exists $match{$eid} ? $match{$eid} + 1 : 1;
                }
            }
        }
    }
    my @eids = keys %match or return '';
    @eids = $sort_order eq 'descend' ?
        sort { $eindex{$b}->{created_on} <=> $eindex{$a}->{created_on} } @eids :
        sort { $eindex{$a}->{created_on} <=> $eindex{$b}->{created_on} } @eids;
    @eids = sort { $match{$b} <=> $match{$a} } @eids;
    splice(@eids, $lastn) if $lastn && (scalar @eids > $lastn);
    require MT::Entry;
    map { push @entries, MT::Entry->load($_) } @eids;
    return '' unless @entries;

    my $res = '';
    my $tokens = $ctx->stash('tokens');
    my $builder = $ctx->stash('builder');
    my $i = 0;
    for my $e (@entries) {
        local $ctx->{__stash}{entry} = $e;
        local $ctx->{current_timestamp} = $e->created_on;
        local $ctx->{modification_timestamp} = $e->modified_on;
        my $out = $builder->build($ctx, $tokens, {
            %$cond,
            EntryIfExtended => $e->text_more ? 1 : 0,
            EntryIfAllowComments => $e->allow_comments,
            EntryIfCommentsOpen => $e->allow_comments && $e->allow_comments eq '1',
            EntryIfAllowPings => $e->allow_pings,
            EntriesHeader => !$i,
            EntriesFooter => !defined $entries[$i+1]
            });
        return $ctx->error($ctx->errstr) unless defined $out;
        $res .= $out;
        $i++;
    }
    $res;
}

sub encode_urlplus {
    my $s = $_[0];
    return $s unless $_[1];
    require MT::Util;
    $s =~ tr/ /+/;
    MT::Util::encode_url($s);
}

eval {
    require MT::XSearch;
    MT::XSearch->add_search_plugin('Tagwire', {
        label => 'Tag(Keyword) Search',
        description => 'Tag(Keyword) Search plugin for MT-XSearch',
        on_execute => \&xsearch_on_execute,
        on_stash => \&xsearch_on_stash });
};

sub xsearch_on_stash {
    $_[0]->stash('entry', $_[1]);
    $_[0]->{current_timestamp} = $_[1]->created_on;
    $_[0]->{modification_timestamp} = $_[1]->modified_on;
}

sub xsearch_on_execute {
    my $args = shift;
    require MT::Entry;
    my $blog_id = $args->{blog_id} or MT->error('Blog ID is required.');
    my $sort_by = $args->{sort_by} || 'created_on';
    my $sort_order = $args->{sort_order} || 'descend';
    my $delimiter = $args->{delimiter} || '';
    my $case_sensitive = defined $args->{case_sensitive} ?
        $args->{case_sensitive} : 1;

    my @results;
    my @patterns = split_args($args->{search}, $delimiter, $case_sensitive)
        or return \@results;

    my $data = get_pd_indexes($blog_id) || get_db_indexes($blog_id)
        or return \@results;
    my %tindex = %{$data->{tindex}};
    my %eindex = %{$data->{eindex}};
    my %match;
    if ($case_sensitive) {
        foreach my $tag (@patterns) {
            foreach my $eid (@{$tindex{$tag}}) {
                $match{$eid} = exists $match{$eid} ? $match{$eid} + 1 : 1;
            }
        }
    } else {
        foreach my $tag (@patterns) {
            foreach my $mtag (grep { lc $_ eq $tag } keys %tindex) {
                foreach my $eid (@{$tindex{$mtag}}) {
                    $match{$eid} = exists $match{$eid} ? $match{$eid} + 1 : 1;
                }
            }
        }
    }
    my $count = scalar @patterns;
    my @eids = grep { $match{$_} == $count } keys %match
        or return \@results;
    @eids = $sort_order eq 'descend' ?
        sort { $eindex{$b}->{created_on} <=> $eindex{$a}->{created_on} } @eids :
        sort { $eindex{$a}->{created_on} <=> $eindex{$b}->{created_on} } @eids;
    require MT::Entry;
    map { push @results, MT::Entry->load($_) } @eids;
    \@results;
}

1;