root/tagwire/tags/0.26/tagwire.pl

Revision 211, 19.8 kB (checked in by ogawa, 2 years ago)

Lots of changes.
Fix for memory leak in the persistent environments such as FastCGI.
Now properly update MT::PluginData? when removing entries.

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