root/branches/release-34/lib/MT/Category.pm @ 1823

Revision 1823, 15.1 kB (checked in by takayama, 20 months ago)

Fixed BugId:67959
* Added check for result of object loading

  • Property svn:keywords set to Author Date Id Revision
Line 
1# Movable Type (r) Open Source (C) 2001-2008 Six Apart, Ltd.
2# This program is distributed under the terms of the
3# GNU General Public License, version 2.
4#
5# $Id$
6
7package MT::Category;
8
9use strict;
10use base qw( MT::Object );
11
12use MT::Blog;
13
14__PACKAGE__->install_properties({
15    column_defs => {
16        'id' => 'integer not null auto_increment',
17        'blog_id' => 'integer not null',
18        'label' => 'string(100) not null',
19        'author_id' => 'integer',
20        'ping_urls' => 'text',
21        'description' => 'text',
22        'parent' => 'integer',
23        'allow_pings' => 'boolean',
24        'basename' => 'string(255)',
25    },
26    indexes => {
27        blog_id => 1,
28        label => 1,
29        parent => 1,
30        basename => 1,
31        blog_class => {
32            columns => [ 'blog_id', 'class' ],
33        },
34    },
35    defaults => {
36        parent => 0,
37        allow_pings => 0,
38    },
39    class_type => 'category',
40    child_of => 'MT::Blog',
41    audit => 1,
42    child_classes => ['MT::Placement', 'MT::Trackback', 'MT::FileInfo'],
43    datasource => 'category',
44    primary_key => 'id',
45});
46
47sub class_label {
48    MT->translate("Category");
49}
50
51sub class_label_plural {
52    MT->translate("Categories");
53}
54
55sub basename_prefix {
56    my $this = shift;
57    my ($dash) = @_;
58    my $prefix = 'cat';
59    if ($dash) {
60        $prefix .= MT->instance->config('CategoryNameNodash') ? '' : '-';
61    }
62    $prefix;
63}
64
65sub ping_url_list {
66    my $cat = shift;
67    return [] unless $cat->ping_urls && $cat->ping_urls =~ /\S/;
68    [ split /\r?\n/, $cat->ping_urls ];
69}
70
71sub publish_path {
72    my $cat = shift;
73    return $cat->{__path} if exists $cat->{__path};
74    my $result = $cat->basename;
75    do {
76        # TODO: uh, does this not mean we cache the resulting path on the
77        # root category object instead?
78        $cat = $cat->parent ? __PACKAGE__->load($cat->parent) : undef;
79        $result = join "/", $cat->basename, $result if $cat;
80    } while ($cat);
81    # caching this information may be problematic IF
82    # parent category basenames are changed.
83    $cat->{__path} = $result;
84}
85*category_path = \&publish_path;
86
87sub category_label_path {
88    my $cat = shift;
89    return $cat->{__label_path} if exists $cat->{__label_path};
90    my $result = $cat->label =~ m!/! ? '[' . $cat->label . ']' : $cat->label;
91    do {
92        $cat = $cat->parent ? __PACKAGE__->load($cat->parent) : undef;
93        $result = join "/", ($cat->label =~ m!/! ? '[' . $cat->label . ']' : $cat->label),
94            $result if $cat;
95    } while ($cat);
96    # caching this information may be problematic IF
97    # parent category labels are changed.
98    $cat->{__label_path} = $result;
99}
100
101sub cache_obj {
102    my $pkg = shift;
103    my (%param) = @_;
104    my $blog_id = $param{blog_id};
105    my $sess_id = 'blog:' . $blog_id;
106    require MT::Session;
107    my $cat_cache = MT::Session::get_unexpired_value(60 * 60, {
108        kind => 'CC',  # category cache
109        id => $sess_id
110    });
111    if (!$cat_cache) {
112        $cat_cache = new MT::Session;
113        $cat_cache->kind('CC');
114        $cat_cache->id($sess_id);
115        $cat_cache->start(time);
116    }
117    $cat_cache;
118}
119
120sub clear_cache {
121    my $pkg = shift;
122    my (%param) = @_;
123    my $cat_cache = $pkg->cache_obj(@_);
124    $cat_cache->remove;
125}
126
127sub cache {
128    my $pkg = shift;
129    my (%param) = @_;
130    my $blog_id = $param{blog_id};
131    my $sess_id = 'blog:' . $blog_id;
132    my $cat_cache = $pkg->cache_obj(@_);
133    my $data = $cat_cache->get('category_cache');
134    if (!$data) {
135        my $cat_iter = $pkg->load_iter({blog_id => $blog_id});
136        $data = [];
137        while (my $cat = $cat_iter->()) {
138            push @$data, [ $cat->id, $cat->label, $cat->parent ];
139        }
140        $cat_cache->set('category_cache', $data);
141        $cat_cache->save;
142    }
143    $data || [];
144}
145
146sub save {
147    my $cat = shift;
148    my $pkg = ref($cat);
149
150    my $clear_cache;
151    if ($cat->id) {
152        my $orig_cat = $pkg->load($cat->id);
153        if (!$orig_cat || ($orig_cat->label ne $cat->label) || ($orig_cat->parent != $cat->parent)) {
154            $clear_cache = 1;
155        }
156    } else {
157        # new category-- invalidate any cache
158        $clear_cache = 1;
159    }
160
161    # check that the parent is legit.
162    if ($cat->parent && $cat->parent ne '0') {
163        my $parent = $pkg->load($cat->parent);
164        $cat->parent(0) unless $parent;
165    }
166
167    if ($cat->parent && $cat->parent ne '0') {
168        my $parent = $pkg->load($cat->parent);
169        if (!$parent) {
170            return $cat->error(MT->translate("Categories must exist within the same blog"))
171                if ($cat->blog_id != $parent->blog_id);
172            return $cat->error(MT->translate("Category loop detected"))
173                if ($cat->id && $cat->is_ancestor($parent));
174        }
175    }
176
177    $cat->SUPER::save(@_) or return;
178
179    # set category basename after save, because of cat_id needed.
180    if (!defined($cat->basename) || ($cat->basename eq '')) {
181        require MT::Util;
182        my $name = MT::Util::make_unique_category_basename($cat);
183        $cat->basename($name);
184        $cat->SUPER::save(@_) or return;
185    }
186
187    ## If pings are allowed on this entry, create or update
188    ## the corresponding Trackback object for this entry.
189    require MT::Trackback;
190    if ($cat->allow_pings) {
191        my $tb;
192        unless ($tb = MT::Trackback->load({
193                                 category_id => $cat->id })) {
194            $tb = MT::Trackback->new;
195            $tb->blog_id($cat->blog_id);
196            $tb->category_id($cat->id);
197            $tb->entry_id(0);   ## entry_id can't be NULL
198        }
199        if (defined(my $pass = $cat->{__tb_passphrase})) {
200            $tb->passphrase($pass);
201        }
202        $tb->title($cat->label);
203        $tb->description($cat->description);
204        my $blog = MT::Blog->load($cat->blog_id)
205            or return;
206        my $url = $blog->archive_url;
207        $url .= '/' unless $url =~ m!/$!;
208        $url .= MT::Util::archive_file_for(undef, $blog,
209            'Category', $cat);
210        $tb->url($url);
211        $tb->is_disabled(0);
212        $tb->save
213            or return $cat->error($tb->errstr);
214    } else {
215        ## If there is a TrackBack item for this category, but
216        ## pings are now disabled, make sure that we mark the
217        ## object as disabled.
218        if (my $tb = MT::Trackback->load({
219                                  category_id => $cat->id })) {
220            $tb->is_disabled(1);
221            $tb->save
222                or return $cat->error($tb->errstr);
223        }
224    }
225    if ($clear_cache) {
226        $pkg->clear_cache('blog_id' => $cat->blog_id);
227    }
228    1;
229}
230
231sub remove {
232    my $cat = shift;
233    $cat->remove_children({ key => 'category_id' });
234    if (ref $cat) {
235        my $pkg = ref($cat);
236        # orphan my children up to the root level
237        my @children = $cat->children_categories;
238        if (scalar @children) {
239            foreach my $child (@children) {
240                $child->parent(($cat->parent) ? $cat->parent : '0');
241                $child->save or return $cat->error($child->save);
242            }
243        } else {
244            $pkg->clear_cache('blog_id' => $cat->blog_id);
245        }
246    }
247    $cat->SUPER::remove(@_);
248}
249
250
251sub _flattened_category_hierarchy {
252    # Either the class name or a MT::Category object
253    my $cat = shift;
254    my $class = ref($cat) || $cat;
255    my @cats = ();
256    my @flattened_cats = ();
257
258    if (!ref ($cat)) {
259        # If it is the class name (i.e. called "statically")
260        # Grab the blog_id from the parameters list and get the top level categories
261        my $blog_id = shift or return ();
262
263        my @cats = $class->load({ blog_id => $blog_id }, { 'sort' => 'label' });
264        my $children = {};
265        foreach my $cat (@cats) {
266            if ($cat->parent) {
267                my $list = $children->{$cat->parent} ||= [];
268                push @$list, $cat;
269            }
270        }
271        sub __pusher {
272            my ($children, $id) = @_;
273            my $list = $children->{$id};
274            return () unless $list && @$list;
275            my @flat;
276            push @flat, 'BEGIN_SUBCATS';
277            foreach (@$list) {
278                push @flat, $_;
279                if ($children->{$_->id}) {
280                    push @flat, __pusher($children, $_->id);
281                }
282            }
283            push @flat, 'END_SUBCATS';
284            @flat;
285        }
286        foreach my $cat (@cats) {
287            if (!$cat->parent) {
288                push @flattened_cats, $cat;
289                push @flattened_cats, __pusher($children, $cat->id)
290                        if $children->{$cat->id};
291            }
292        }
293        return @flattened_cats;
294    }
295
296    # Otherwise, the starting point is the category itself
297    @cats = ($cat);
298
299    # Depth-first search time
300    foreach my $c (@cats) {
301        # Push the current category onto the list
302        push @flattened_cats, $c;
303
304        # If it has any children
305        my @children = $c->children_categories;
306        if (scalar @children) {
307
308            # Indicate the start of the children
309     
310            push @flattened_cats, "BEGIN_SUBCATS";
311
312            # Add all the kids (and their associated subcategories)
313            foreach my $kid (@children) {
314                push @flattened_cats, ($kid->_flattened_category_hierarchy);
315            }
316
317            # Indicate the end of the children
318            push @flattened_cats, "END_SUBCATS";
319        }
320    }
321
322    @flattened_cats;
323}
324
325# Deprecated routine -- also assumes MT::Category class, so it won't
326# work with folders for instance.
327sub _buildCatHier {
328    my ($blog_id) = @_;
329 
330    require MT::Request;
331
332    my %children;
333
334    my $r = MT::Request->instance;
335    my $all_cats = $r->cache('sub_cats_cats');
336    unless ($all_cats) {
337        $r->cache('sub_cats_cats', $all_cats = {});
338    }
339    my $cats;
340    if (defined $all_cats->{$blog_id}) {
341        my $children = $all_cats->{$blog_id}{'children'};
342        return ($children);
343    }
344
345    # Start by loading all the categories for the given blog
346    # and default to setting all of their parents to '0'
347 
348    my @cats = MT::Category->load({ blog_id => $blog_id });
349    foreach my $cat (@cats) {
350        push @{$children{($cat->parent) ? $cat->parent : '0'}}, $cat;
351    }
352
353    foreach my $i (keys %children) {
354        @{$children{$i}} = sort { $a->label cmp $b->label } @{$children{$i}};
355    }
356
357    $all_cats->{$blog_id}{'children'} = \%children;
358    $r->cache('sub_cats_cats', $all_cats);
359 
360    (\%children);
361}
362
363sub top_level_categories {
364    my ($class, $blog_id) = @_;
365    my @cats = $class->load({ blog_id => $blog_id, parent => '0' }, { 'sort' => 'label' });
366}
367
368sub copy_cat {
369    my $class = shift;
370    my $cat = $class->new;
371    my $old_cat = shift;
372    $cat->set_values($old_cat->column_values);
373    $cat;
374}
375
376sub parent_categories {
377    my $cat = shift;
378
379    return () if (!$cat->parent_category);
380    ($cat->parent_category, $cat->parent_category->parent_categories);
381}
382
383sub parent_category {
384    my $cat = shift;
385    my $class = ref($cat);
386    unless ($cat->{__parent_category}) {
387        $cat->{__parent_category} = ($cat->parent) ? $class->load($cat->parent) : undef;
388    }
389    $cat->{__parent_category};
390}
391
392sub children_categories {
393    my $cat = shift;
394    my $class = ref($cat);
395    unless ($cat->{__children}) {
396        @{$cat->{__children}} = sort { $a->label cmp $b->label }
397        $class->load({ blog_id => $cat->blog_id,
398            parent => $cat->id });
399    }
400    @{$cat->{__children}};
401}
402
403sub is_ancestor {
404    my $cat = shift;
405    my ($possible_child) = @_;
406
407    # Catch the different blog edge case
408    return 0 if $cat->blog_id != $possible_child->blog_id;
409
410    return 1 if $cat->id == $possible_child->id;
411
412    # Keep having the child bump up one level in the hierarchy
413    # to see if it ever reaches the current category
414    # (more efficient then descending from the current category
415    # as the children lists do not need to be calculated
416
417    my $class = ref($cat);
418    while (my $id = $possible_child->parent) {
419        $possible_child = $class->load($id);
420        return 1 if $cat->id == $possible_child->id;
421    }
422 
423    # Looks like we didn't find it
424    0;
425}
426
427sub is_descendant {
428    my $cat = shift;
429    my ($possible_parent) = @_;
430    $possible_parent->is_ancestor($cat);
431}
432
4331;
434__END__
435
436=head1 NAME
437
438MT::Category - Movable Type category record
439
440=head1 SYNOPSIS
441
442    use MT::Category;
443    my $cat = MT::Category->new;
444    $cat->blog_id($blog->id);
445    $cat->label('My Category');
446    my @children = $cat->children;
447    $cat->save
448        or die $cat->errstr;
449
450=head1 DESCRIPTION
451
452An I<MT::Category> object represents a category in the Movable Type system.
453It is essentially a wrapper around the category label; by wrapping the label
454in an object with a numeric ID, we can use the ID as a "foreign key" when
455mapping entries into categories. Thus, if the category label changes, the
456mappings don't break. This object does not contain any information about the
457category-entry mappings--for those, look at the I<MT::Placement> object.
458
459=head1 USAGE
460
461As a subclass of I<MT::Object>, I<MT::Category> inherits all of the
462data-management and -storage methods from that class; thus you should look
463at the I<MT::Object> documentation for details about creating a new object,
464loading an existing object, saving an object, etc.
465
466=head1 DATA ACCESS METHODS
467
468The I<MT::Category> object holds the following pieces of data. These fields
469can be accessed and set using the standard data access methods described in
470the I<MT::Object> documentation.
471
472=over 4
473
474=item * id
475
476The numeric ID of the category.
477
478=item * blog_id
479
480The numeric ID of the blog to which this category belongs.
481
482=item * label
483
484The label of the category.
485
486=item * author_id
487
488The numeric ID of the author you created this category.
489
490=item * parent_category
491
492Returns a I<MT::Category> object representing the immediate parent category.
493Returns undef if there is none.
494
495=item * parent_categories
496
497Returns an array of I<MT::Category> objects representing the path from the
498category to the top level of categories, with the first member of the array
499being the immediate parent.  Returns an empty array if the category is already
500at the top level.
501
502=item * children_categories
503
504Returns an array of I<MT::Category> objects representing all of the
505immediate children of the category.
506
507=item * $subcat->is_descendant($parent)
508
509Returns a true value if the category is a descendant of $parent.
510
511=item * $subcat->is_ancestor($child)
512
513Returns a true value if the category is an ancestor of $child.
514
515=back
516
517=head1 DATA LOOKUP
518
519In addition to numeric ID lookup, you can look up or sort records by any
520combination of the following fields. See the I<load> documentation in
521I<MT::Object> for more information.
522
523=over 4
524
525=item * blog_id
526
527=item * label
528
529=back
530
531=head1 NOTES
532
533=over 4
534
535=item *
536
537When you remove a category using I<MT::Category::remove>, in addition to
538removing the category record, all of the entry-category mappings
539(I<MT::Placement> objects) will be removed.
540
541=back
542
543=head1 CLASS METHODS
544
545=over 4
546
547=item * MT::Category->top_level_categories($blog_id)
548
549
550Returns an array of I<MT::Category> objects representing the top level of
551the category hierarchy in the blog identified by $blog_id.
552
553=back
554
555=head1 AUTHOR & COPYRIGHTS
556
557Please see the I<MT> manpage for author, copyright, and license information.
558
559=cut
Note: See TracBrowser for help on using the browser.