root/tagwire/tags/0.24a/tagwire.pl

Revision 107, 19.7 kB (checked in by ogawa, 3 years ago)

Several bug fixes.

  • Property svn:keywords set to Id Author Date Rev
Line 
1# Tagwire Plugin (aka AllKeywords Plugin)
2# a plugin for listing and handling "tags"
3#
4# $Id$
5#
6# This software is provided as-is. You may use it for commercial or
7# personal use. If you distribute it, please keep this notice intact.
8#
9# Copyright (c) 2005 Hirotaka Ogawa
10
11package MT::Plugin::Tagwire;
12use strict;
13use MT::Template::Context;
14use MT::Request;
15use vars qw($VERSION);
16
17$VERSION = '0.24';
18
19# DEBUG
20my $FORCE_PD_REFRESH = 0;
21my $ENABLE_PD_INDEXES = 1;
22my $ENABLE_REQ_CACHE = 1;
23
24my $plugin;
25eval {
26    require MT::Plugin;
27    $plugin = new MT::Plugin({
28        name => 'Tagwire Plugin',
29        description => 'A plugin for listing and handling blog-wide tags and entry tags.',
30        doc_link => 'http://as-is.net/hacks/2005/06/tagwire_plugin.html',
31        author_name => 'Hirotaka Ogawa',
32        author_link => 'http://profile.typekey.com/ogawa/',
33        version => $VERSION
34        });
35    MT->add_plugin($plugin);
36};
37
38if (MT->can('add_callback')) {
39    my $mt = MT->instance;
40    MT->add_callback((ref $mt eq 'MT::App::CMS' ? 'AppPostEntrySave' : 'MT::Entry::post_save'),
41                     10, $plugin, \&update_pd_indexes);
42}
43
44sub update_pd_indexes {
45    return unless $ENABLE_PD_INDEXES && $plugin;
46    my ($eh, $app, $entry) = @_;
47    require MT::Entry;
48    my $blog_id = $entry->blog_id;
49    require MT::PluginData;
50    my $pd = MT::PluginData->load({ plugin => $plugin->name,
51                                    key => $blog_id });
52    my (%eindex, %tindex);
53    my $data;
54    my $refresh = $FORCE_PD_REFRESH || 0;
55    if (!$pd) {
56        $pd = new MT::PluginData();
57        $pd->plugin($plugin->name);
58        $pd->key($blog_id);
59        $refresh = 1;
60    }
61    $data = $pd->data() || {};
62    $refresh = 1 if !exists $data->{version} || ${$data->{version}} ne $VERSION;
63    if ($refresh) {
64        my $iter = MT::Entry->load_iter({ blog_id => $blog_id,
65                                          status => MT::Entry::RELEASE() });
66        while (my $e = $iter->()) {
67            my @tags = split_tags($e->keywords, 1) or next;
68            $eindex{$e->id} = { tags => \@tags,
69                                created_on => $e->created_on };
70        }
71    } else {
72        my $eid = $entry->id;
73        %eindex = %{$data->{eindex}};
74        delete $eindex{$eid} if exists $eindex{$eid};
75        if ($entry->status == MT::Entry::RELEASE()) {
76            my @tags = split_tags($entry->keywords, 1);
77            $eindex{$eid} = { tags => \@tags,
78                              created_on => $entry->created_on };
79        }
80    }
81    foreach my $eid (keys %eindex) {
82        my $ts = $eindex{$eid}->{created_on};
83        foreach (@{$eindex{$eid}->{tags}}) {
84            push @{$tindex{$_}->{eids}}, $eid;
85            $tindex{$_}->{ts} = $ts if $tindex{$_}->{ts} < $ts;
86        }
87    }
88    $data->{version} = \$VERSION;
89    $data->{eindex} = \%eindex;
90    $data->{tindex} = \%tindex;
91    $pd->data($data);
92    $pd->save or die $pd->errstr;
93    if ($ENABLE_REQ_CACHE) {
94        my $r = MT::Request->instance;
95        $r->cache('Tagwire::Cache::' . $blog_id, undef);
96    }
97}
98
99MT::Template::Context->add_container_tag('Tags' => \&tags);
100MT::Template::Context->add_container_tag('EntryTags' => \&entry_tags);
101MT::Template::Context->add_container_tag('RelatedTags' => \&related_tags);
102MT::Template::Context->add_tag('Tag' => \&tag);
103MT::Template::Context->add_tag('TagCount' => \&tag_count);
104MT::Template::Context->add_tag('TagDate' => \&tag_date);
105MT::Template::Context->add_tag('TagsTotal' => \&tags_total);
106MT::Template::Context->add_tag('TagsTotalSum' => \&tags_total_sum);
107MT::Template::Context->add_container_tag('EntriesWithTags' => \&entries);
108MT::Template::Context->add_container_tag('MostRelatedEntries' => \&most_related_entries);
109MT::Template::Context->add_global_filter('encode_urlplus' => \&encode_urlplus);
110
111# For compatibility (this plugin was formerly named 'AllKeywords')
112MT::Template::Context->add_container_tag('AllKeywords' => \&tags);
113MT::Template::Context->add_container_tag('EntryAllKeywords' => \&entry_tags);
114MT::Template::Context->add_tag('AllKeyword' => \&tag);
115MT::Template::Context->add_tag('AllKeywordCount' => \&tag_count);
116MT::Template::Context->add_tag('AllKeywordsTotal' => \&tags_total);
117MT::Template::Context->add_tag('AllKeywordsTotalSum' => \&tags_total_sum);
118MT::Template::Context->add_container_tag('EntriesWithKeywords' => \&entries);
119
120sub split_args {
121    my ($string, $delimiter, $case_sensitive) = @_;
122    return unless $string;
123    $string =~ s/(^\s+|\s+$)//g;
124    $string = lc $string unless $case_sensitive;
125
126    return split(/\s+/, $string) unless $delimiter;
127
128    my @tags;
129    foreach my $tag (split($delimiter, $string)) {
130        $tag =~ s/(^\s+|\s+$)//g;
131        push @tags, $tag if $tag;
132    }
133    @tags;
134}
135
136sub split_tags {
137    my ($string, $case_sensitive) = @_;
138    return unless $string;
139    my @tags;
140    $string =~ s/(^\s+|\s+$)//g;
141    $string = lc $string unless $case_sensitive;
142#    $string =~ s/\[[^[]+\]//g; # uncomment this to discard [short title]
143
144    if ($string =~ m/[;,|]/) {
145        # tags separated by non-whitespaces
146        while ($string =~ m/(\[[^]]+\]|"[^"]+"|'[^']+'|[^;,|]+)/g) {
147            my $tag = $1;
148            $tag =~ s/(^[\["'\s;,|]+|[\]"'\s;,|]+$)//g;
149            push @tags, $tag if $tag;
150        }
151    } else {
152        # tags separated by whitespaces
153        while ($string =~ m/(\[[^]]+\]|"[^"]+"|'[^']+'|[^\s]+)/g) {
154            my $tag = $1;
155            $tag =~ s/(^[\["'\s]+|[\]"'\s]+$)//g;
156            push @tags, $tag if $tag;
157        }
158    }
159    @tags;
160}
161
162sub get_pd_indexes {
163    return unless $ENABLE_PD_INDEXES && $plugin;
164    my $blog_id = $_[0] or return;
165    my ($r, $cname);
166    if ($ENABLE_REQ_CACHE) {
167        $r = MT::Request->instance;
168        $cname = 'Tagwire::Cache::' . $blog_id;
169        return $r->cache($cname) if defined $r->cache($cname);
170        $r->cache($cname, undef);
171    }
172    my $data;
173    eval {
174        require MT::PluginData;
175        my $pd = MT::PluginData->load({ plugin => $plugin->name,
176                                        key => $blog_id });
177        $data = $pd->data() if $pd;
178    };
179    return if !exists $data->{version} || ${$data->{version}} ne $VERSION;
180    $r->cache($cname, $data) if $ENABLE_REQ_CACHE && $data;
181    $data;
182}
183
184sub get_db_indexes {
185    my $blog_id = $_[0] or return;
186    my ($r, $cname);
187    if ($ENABLE_REQ_CACHE) {
188        $r = MT::Request->instance;
189        $cname = 'Tagwire::Cache::' . $blog_id;
190        return $r->cache($cname) if defined $r->cache($cname);
191        $r->cache($cname, undef);
192    }
193    my $data;
194    my (%eindex, %tindex);
195    my $iter = MT::Entry->load_iter({ blog_id => $blog_id,
196                                      status => MT::Entry::RELEASE() });
197    while (my $e = $iter->()) {
198        my @tags = split_tags($e->keywords, 1) or next;
199        $eindex{$e->id} = { tags => \@tags,
200                            created_on => $e->created_on };
201    }
202    foreach my $eid (keys %eindex) {
203        my $ts = $eindex{$eid}->{created_on};
204        foreach (@{$eindex{$eid}->{tags}}) {
205            push @{$tindex{$_}->{eids}}, $eid;
206            $tindex{$_}->{ts} = $ts if $tindex{$_}->{ts} < $ts;
207        }
208    }
209    $data->{eindex} = \%eindex;
210    $data->{tindex} = \%tindex;
211    $r->cache($cname, $data) if $ENABLE_REQ_CACHE;
212    $data;
213}
214
215sub tags {
216    my ($ctx, $args, $cond) = @_;
217
218    # sort_by (tag/tag-case/count, default = tag)
219    my $sort_by = $args->{sort_by} || 'tag';
220    # sort_order (ascend/descend, default = ascend)
221    my $sort_order = $args->{sort_order} || 'ascend';
222    # lastn (default = 0, no cutoff)
223    my $lastn = $args->{lastn} || 0;
224    # case_sensitive (0/1, default = 1)
225    my $case_sensitive = defined $args->{case_sensitive} ?
226        $args->{case_sensitive} : 1;
227
228    my $blog_id = $ctx->stash('blog_id');
229    my %tags = ();
230    my %ts = ();
231
232    my $data = get_pd_indexes($blog_id) || get_db_indexes($blog_id)
233        or return '';
234    my %tindex = %{$data->{tindex}};
235    if ($case_sensitive) {
236        foreach (keys %tindex) {
237            $tags{$_} = scalar @{$tindex{$_}->{eids}};
238            $ts{$_} = $tindex{$_}->{ts};
239        }
240    } else {
241        foreach (keys %tindex) {
242            $tags{lc $_} += scalar @{$tindex{$_}->{eids}};
243            $ts{lc $_} = $tindex{$_}->{ts} if $ts{lc $_} < $tindex{$_}->{ts};
244        }
245    }
246
247    my @list;
248    if ($sort_by eq 'tag' || $sort_by eq 'keyword' ) {
249        @list = $sort_order eq 'ascend' ?
250            sort { lc $a cmp lc $b } keys %tags :
251            sort { lc $b cmp lc $a } keys %tags;
252    } elsif ($sort_by eq 'tag-case' || $sort_by eq 'keyword-case') {
253        @list = $sort_order eq 'ascend' ?
254            sort keys %tags :
255            sort reverse keys %tags;
256    } else {
257        @list = $sort_order eq 'ascend' ?
258            sort { $tags{$a} <=> $tags{$b} } keys %tags :
259            sort { $tags{$b} <=> $tags{$a} } keys %tags;
260    }
261
262    $ctx->stash('Tagwire::tags_total', scalar @list);
263
264    my $total_sum = 0;
265    $total_sum += $tags{$_} foreach (@list);
266    $ctx->stash('Tagwire::tags_total_sum', $total_sum);
267
268    my @res;
269    my $builder = $ctx->stash('builder');
270    my $tokens = $ctx->stash('tokens');
271    my $i = 0;
272    foreach (@list) {
273        last if $lastn && $i >= $lastn;
274        local $ctx->{__stash}{'Tagwire::tag'} = $_;
275        local $ctx->{__stash}{'Tagwire::tag_count'} = $tags{$_};
276        local $ctx->{__stash}{'Tagwire::tag_date'} = $ts{$_};
277        defined(my $out = $builder->build($ctx, $tokens))
278            or return $ctx->error($ctx->errstr);
279        push @res, $out;
280        $i++;
281    }
282    my $glue = $args->{glue} || '';
283    join $glue, @res;
284}
285
286sub entry_tags {
287    my ($ctx, $args, $cond) = @_;
288    my $e = $ctx->stash('entry')
289        or return $ctx->_no_entry_error('MT' . $ctx->stash('tag'));
290    return '' unless $e->keywords;
291
292    # case_sensitive (0/1, default = 1)
293    my $case_sensitive = defined $args->{case_sensitive} ?
294        $args->{case_sensitive} : 1;
295
296    my @tags = split_tags($e->keywords, $case_sensitive);
297    my @res;
298    my $builder = $ctx->stash('builder');
299    my $tokens = $ctx->stash('tokens');
300    foreach (@tags) {
301        local $ctx->{__stash}{'Tagwire::tag'} = $_;
302        defined(my $out = $builder->build($ctx, $tokens))
303            or return $ctx->error($ctx->errstr);
304        push @res, $out;
305    }
306    my $glue = $args->{glue} || '';
307    join $glue, @res;
308}
309
310sub related_tags {
311    my ($ctx, $args, $cond) = @_;
312    my $tag = $ctx->stash('Tagwire::tag') or return '';
313
314    my $sort_by = $args->{sort_by} || 'tag';
315    # sort_order (ascend/descend, default = ascend)
316    my $sort_order = $args->{sort_order} || 'ascend';
317    # lastn (default = 0, no cutoff)
318    my $lastn = $args->{lastn} || 0;
319    # case_sensitive (0/1, default = 1)
320    my $case_sensitive = defined $args->{case_sensitive} ?
321        $args->{case_sensitive} : 1;
322
323    my $blog_id = $ctx->stash('blog_id');
324    my %tags = ();
325    my %ts = ();
326
327    my $data = get_pd_indexes($blog_id) || get_db_indexes($blog_id)
328        or return '';
329    my %tindex = %{$data->{tindex}};
330    my %eindex = %{$data->{eindex}};
331    if ($case_sensitive) {
332        foreach my $eid (@{$tindex{$tag}->{eids}}) {
333            foreach (@{$eindex{$eid}->{tags}}) {
334                next if $_ eq $tag;
335                $tags{$_} = exists $tags{$_} ? $tags{$_} + 1 : 1;
336                $ts{$_} = $tindex{$_}->{ts} if !defined $ts{$_};
337            }
338        }
339    } else {
340        $tag = lc $tag;
341        foreach my $nctag (grep { lc $_ eq $tag } keys %tindex) {
342            foreach my $eid (@{$tindex{$nctag}->{eids}}) {
343                foreach (@{$eindex{$eid}->{tags}}) {
344                    my $mtag = lc $_;
345                    next if $mtag eq $tag;
346                    $tags{$mtag} = exists $tags{$mtag} ? $tags{$mtag} + 1 : 1;
347                    $ts{$mtag} = $tindex{$_}->{ts} if $ts{$mtag} < $tindex{$_}->{ts};
348                }
349            }
350        }
351    }
352    my @list;
353    if ($sort_by eq 'tag' || $sort_by eq 'keyword' ) {
354        @list = $sort_order eq 'ascend' ?
355            sort { lc $a cmp lc $b } keys %tags :
356            sort { lc $b cmp lc $a } keys %tags;
357    } elsif ($sort_by eq 'tag-case' || $sort_by eq 'keyword-case') {
358        @list = $sort_order eq 'ascend' ?
359            sort keys %tags :
360            sort reverse keys %tags;
361    } else {
362        @list = $sort_order eq 'ascend' ?
363            sort { $tags{$a} <=> $tags{$b} } keys %tags :
364            sort { $tags{$b} <=> $tags{$a} } keys %tags;
365    }
366
367    $ctx->stash('Tagwire::tags_total', scalar @list);
368
369    my $total_sum = 0;
370    $total_sum += $tags{$_} foreach (@list);
371    $ctx->stash('Tagwire::tags_total_sum', $total_sum);
372
373    my @res;
374    my $builder = $ctx->stash('builder');
375    my $tokens = $ctx->stash('tokens');
376    my $i = 0;
377    foreach (@list) {
378        last if $lastn && $i >= $lastn;
379        local $ctx->{__stash}{'Tagwire::tag'} = $_;
380        local $ctx->{__stash}{'Tagwire::tag_count'} = $tags{$_};
381        local $ctx->{__stash}{'Tagwire::tag_date'} = $ts{$_};
382        defined(my $out = $builder->build($ctx, $tokens))
383            or return $ctx->error($ctx->errstr);
384        push @res, $out;
385        $i++;
386    }
387    my $glue = $args->{glue} || '';
388    join $glue, @res;
389}
390
391sub tag {
392    $_[0]->stash('Tagwire::tag') || '';
393}
394
395sub tag_count {
396    $_[0]->stash('Tagwire::tag_count') || 0;
397}
398
399sub tag_date {
400    my ($ctx, $args) = @_;
401    $args->{ts} = $ctx->stash('Tagwire::tag_date')
402        or return '';
403    MT::Template::Context::_hdlr_date($ctx, $args);
404}
405
406sub tags_total {
407    $_[0]->stash('Tagwire::tags_total') || 0;
408}
409
410sub tags_total_sum {
411    $_[0]->stash('Tagwire::tags_total_sum') || 0;
412}
413
414sub entries {
415    my ($ctx, $args, $cond) = @_;
416
417    # tags(keywords) (REQUIRED)
418    my $search = $args->{tags} || $args->{keywords} or return '';
419    # delimiter for "tags" argument (default = space characters)
420    my $delimiter = $args->{delimiter} || '';
421    # case_sensitive (0/1, default = 1)
422    my $case_sensitive = defined $args->{case_sensitive} ?
423        $args->{case_sensitive} : 1;
424    # sort_by (created_on, default = created_on)
425    my $sort_by = $args->{sort_by} || 'created_on';
426    # sort_order (ascend/descend, default = descend)
427    my $sort_order = $args->{sort_order} || 'descend';
428    # lastn (default = 0, no cutoff)
429    my $lastn = $args->{lastn} || 0;
430
431    my @tags = split_args($search, $delimiter, $case_sensitive)
432        or return '';
433
434    my $blog_id = $ctx->stash('blog_id');
435    my $data = get_pd_indexes($blog_id) || get_db_indexes($blog_id)
436        or return '';
437    my %tindex = %{$data->{tindex}};
438    my %eindex = %{$data->{eindex}};
439    my %match;
440    if ($case_sensitive) {
441        foreach my $tag (@tags) {
442            foreach (@{$tindex{$tag}->{eids}}) {
443                $match{$_} = exists $match{$_} ? $match{$_} + 1 : 1;
444            }
445        }
446    } else {
447        foreach my $tag (@tags) {
448            foreach my $mtag (grep { lc $_ eq $tag } keys %tindex) {
449                foreach (@{$tindex{$mtag}->{eids}}) {
450                    $match{$_} = exists $match{$_} ? $match{$_} + 1 : 1;
451                }
452            }
453        }
454    }
455    my $count = scalar @tags;
456    my @eids = grep { $match{$_} == $count } keys %match or return '';
457    @eids = $sort_order eq 'descend' ?
458        sort { $eindex{$b}->{created_on} <=> $eindex{$a}->{created_on} } @eids :
459        sort { $eindex{$a}->{created_on} <=> $eindex{$b}->{created_on} } @eids;
460    splice(@eids, $lastn) if $lastn && (scalar @eids > $lastn);
461    require MT::Entry;
462    my @entries;
463    map { push @entries, MT::Entry->load($_) } @eids;
464
465    my $res = '';
466    my $tokens = $ctx->stash('tokens');
467    my $builder = $ctx->stash('builder');
468    my $i = 0;
469    for my $e (@entries) {
470        local $ctx->{__stash}{entry} = $e;
471        local $ctx->{current_timestamp} = $e->created_on;
472        local $ctx->{modification_timestamp} = $e->modified_on;
473        my $out = $builder->build($ctx, $tokens, {
474            %$cond,
475            EntryIfExtended => $e->text_more ? 1 : 0,
476            EntryIfAllowComments => $e->allow_comments,
477            EntryIfCommentsOpen => $e->allow_comments && $e->allow_comments eq '1',
478            EntryIfAllowPings => $e->allow_pings,
479            EntriesHeader => !$i,
480            EntriesFooter => !defined $entries[$i+1]
481            });
482        return $ctx->error($ctx->errstr) unless defined $out;
483        $res .= $out;
484        $i++;
485    }
486    $res;
487}
488
489sub most_related_entries {
490    my ($ctx, $args, $cond) = @_;
491    my $entry = $ctx->stash('entry')
492        or return $ctx->_no_entry_error('MT' . $ctx->stash('tag'));
493    return '' unless $entry->keywords;
494
495    # case_sensitive (0/1, default = 1)
496    my $case_sensitive = defined $args->{case_sensitive} ?
497        $args->{case_sensitive} : 1;
498    # sort_order (ascend/descend, default = descend)
499    my $sort_order = $args->{sort_order} || 'descend';
500    # lastn (default = 0, no cutoff)
501    my $lastn = $args->{lastn} || 0;
502
503    my @tags = split_tags($entry->keywords, $case_sensitive)
504        or return '';
505
506    my $blog_id = $ctx->stash('blog_id');
507    my $data = get_pd_indexes($blog_id) || get_db_indexes($blog_id)
508        or return '';
509    my %tindex = %{$data->{tindex}};
510    my %eindex = %{$data->{eindex}};
511    my %match;
512    if ($case_sensitive) {
513        foreach my $tag (@tags) {
514            foreach (@{$tindex{$tag}->{eids}}) {
515                next if $_ == $entry->id;
516                $match{$_} = exists $match{$_} ? $match{$_} + 1 : 1;
517            }
518        }
519    } else {
520        foreach my $tag (@tags) {
521            foreach my $mtag (grep { lc $_ eq $tag } keys %tindex) {
522                foreach (@{$tindex{$mtag}->{eids}}) {
523                    next if $_ == $entry->id;
524                    $match{$_} = exists $match{$_} ? $match{$_} + 1 : 1;
525                }
526            }
527        }
528    }
529    my