root/branches/release-29/lib/MT/Category.pm @ 1359

Revision 1359, 14.9 kB (checked in by mpaschal, 22 months ago)

Note what looks like mistreatment of this variable while I'm looking at it

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