root/branches/release-30/lib/MT/Component.pm @ 1427

Revision 1427, 17.4 kB (checked in by mpaschal, 21 months ago)

Add MT::Util::weaken() that lets us weaken references when available from a properly compiled Scalar::Util
Use weaken() to prevent some circular references from leaking some objects
(apply patches by Hirotaka Ogawa and Brad Choate--thanks!)
BugzID: 66845
  • Property svn:keywords set to 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::Component;
8
9use strict;
10use base qw( Class::Accessor::Fast MT::ErrorHandler );
11use MT::Util qw( encode_js weaken );
12
13__PACKAGE__->mk_accessors(qw( id path envelope version schema_version ));
14
15#BEGIN {
16#
17#    # my @registry_methods = qw( callbacks upgrade_functions object_types
18#    #     junk_filters text_filters permissions importers rebuild_options
19#    #     tasks );
20#    my @registry_methods = qw( callbacks );
21#    foreach my $meth (@registry_methods) {
22#        my $sub = sub { &_getset( shift, $meth, @_ ) };
23#        no strict 'refs';
24#        *$meth = $sub;
25#    }
26#}
27
28# static method
29sub select {
30    my ( $pkg, $class ) = @_;
31    if ( $class && $class !~ m/::/ ) {
32        $class = $pkg . '::' . $class;
33    }
34    elsif ( !$class ) {
35        $class = $pkg;
36    }
37    my @plugins;
38    foreach my $p (@MT::Components) {
39        push @plugins, $p if UNIVERSAL::isa( $p, $class );
40    }
41    return @plugins;
42}
43
44sub new {
45    my $class = shift;
46    my ($self) = ref $_[0] ? @_ : {@_};
47    bless $self, $class;
48    $self->init();
49    $self;
50}
51
52sub init {
53    my $c = shift;
54    $c->init_registry() or return;
55
56    # plugin callbacks are initialized after they finish loading.
57    $c->init_callbacks() unless $c->isa('MT::Plugin');
58    $c;
59}
60
61sub init_callbacks {
62    my $c = shift;
63
64    # Tricky; we only want to add this callback IF the plugin
65    # has an init_app callback of it's own; at the same time
66    # we have to declare a superclass init_app method so if
67    # the plugin uses $plugin->SUPER::init_app(), it works.
68    # So we test here to see if the signature of the init_app
69    # method is something other than our stub init_app
70    # method in MT::Component (same goes for init_request below)
71    if ( $c->can('init_app') != \&MT::Component::init_app ) {
72        MT->add_callback(
73            'init_app',
74            5, $c,
75            sub {
76                my $cb = shift;
77                local $MT::plugin_registry = $c->{registry};
78                $c->init_app(@_);
79            }
80        );
81    }
82    elsif (_getset( $c, 'init_app' )
83        || _getset( $c, 'applications' ) )
84    {
85        MT->add_callback( 'init_app', 5, $c, \&on_init_app );
86    }
87
88    if ( $c->can('init_request') != \&MT::Component::init_request ) {
89        MT->add_callback(
90            'init_request',
91            5, $c,
92            sub {
93                my $cb = shift;
94                local $MT::plugin_registry = $c->{registry};
95                $c->init_request(@_);
96            }
97        );
98    }
99    elsif ( _getset( $c, 'init_request' ) || _getset( $c, 'applications' ) ) {
100        MT->add_callback( 'init_request', 5, $c, \&on_init_request );
101    }
102
103    if ( $c->{init_tasks} ) {
104        MT->add_callback( 'tasks', 5, $c, $c->{init_tasks} );
105    }
106    elsif ( $c->can('init_tasks') ) {
107        MT->add_callback( 'tasks', 5, $c,
108            sub { my $cb = shift; $c->init_tasks(@_) } );
109    }
110
111    if ( my $callbacks = $c->callbacks ) {
112        if ( ref $callbacks eq 'ARRAY' ) {
113            foreach my $cb (@$callbacks) {
114                MT->add_callback( $_->{name}, $cb->{priority} || 5,
115                    $c, $cb->{handler} || $cb->{code} );
116            }
117        }
118        elsif ( ref $callbacks eq 'HASH' ) {
119            foreach my $cbname ( keys %$callbacks ) {
120                if ( ref $callbacks->{$cbname} eq 'CODE' ||  (ref $callbacks->{$cbname} eq '' && $callbacks->{$cbname})) {
121                    MT->add_callback( $cbname, 5, $c, $callbacks->{$cbname} );
122                }
123                elsif ( ref $callbacks->{$cbname} eq 'HASH' ) {
124                    MT->add_callback(
125                        $callbacks->{$cbname}{callback} || $cbname,
126                        $callbacks->{$cbname}{priority} || 5,
127                        $c,
128                        $callbacks->{$cbname}{handler}
129                          || $callbacks->{$cbname}{code}
130                    );
131                }
132                elsif ( ref $callbacks->{$cbname} eq 'ARRAY' ) {
133                    my $list = $callbacks->{$cbname};
134                    MT->add_callback( $cbname, $_->{priority} || 5,
135                        $c, $_->{handler} || $_->{code} )
136                      foreach @$list;
137                }
138            }
139        }
140    }
141}
142
143sub load_registry {
144    my $c      = shift;
145    my ($file) = @_;
146    my $path   = $c->path or return;
147    $path = File::Spec->catfile( $c->path, $file );
148    return unless -f $path;
149    require YAML::Tiny;
150    my $y = eval { YAML::Tiny->read($path) }
151        or die "Error reading $path: " . $YAML::Tiny::errstr;
152    if ( ref($y) ) {
153
154        # skip over non-hash elements
155        shift @$y while @$y && ( ref( $y->[0] ) ne 'HASH' );
156        return $y->[0] if @$y;
157    }
158    return {};
159}
160
161sub init_registry {
162    my $c = shift;
163    my $r = $c->load_registry("config.yaml");
164    if ( !$r ) {
165        return 1;
166    }
167
168   # TBD: 'extends' support...
169   # if (my $ext = $r->{extends}) {
170   #     # require any other components declared here
171   #     $ext = [ $ext ] unless ref($ext) eq 'ARRAY';
172   #     foreach my $comp (@$ext) {
173   #         MT->require_component($comp)
174   #             or return $c->error("Error loading required component: $comp");
175   #     }
176   # }
177    $c->registry($r);
178
179    # map key registry elements into metadata
180    foreach my $prop (qw(version schema_version)) {
181        $c->$prop( $r->{$prop} ) if exists $r->{$prop};
182    }
183    $c->name( $r->{label} ) if exists $r->{label};
184    return 1;
185}
186
187sub callbacks {
188    my $c = shift;
189    my $root_cb = _getset($c, 'callbacks') || {};
190    my $apps = _getset($c, 'applications');
191    for my $app (keys %$apps) {
192        my @path = qw( applications );
193        push @path, $app;
194        my $r = $c->registry( @path );
195        if ($r) {
196            my $cb = _getset($r, 'callbacks') || {};
197            MT::__merge_hash($root_cb, $cb);
198        }
199    }
200    return $root_cb;
201}
202
203# STUB
204sub init_app { }
205sub init_request { }
206
207sub on_init_app {
208    my $cb      = shift;
209    my $c       = $cb->plugin;
210    my ($app)   = @_;
211    my $app_pkg = ref $app;
212    my $init;
213    if ( $init = _getset( $c, 'init_app' ) ) {
214        if ( ref $init eq 'HASH' ) {
215            $init = $init->{$app_pkg};
216        }
217    }
218    else {
219        $init = $c->registry( "applications", $app->id, "init" );
220    }
221    if ( $init && !ref($init) ) {
222        $init = MT->handler_to_coderef($init);
223    }
224    if ( $init && ( ref $init eq 'CODE' ) ) {
225        local $MT::plugin_registry = $c->{registry};
226        $init->( $c, @_ );
227    }
228    elsif ( $c->can('init_app') ) {
229        local $MT::plugin_registry = $c->{registry};
230        $c->init_app(@_);
231    }
232}
233
234sub on_init_request {
235    my $cb      = shift;
236    my $c       = $cb->plugin;
237    my ($app)   = @_;
238    my $app_pkg = ref $app;
239    my $init;
240    if ( $init = _getset( $c, 'init_request' ) ) {
241        if ( ref $init eq 'HASH' ) {
242            $init = $init->{$app_pkg} if exists $init->{$app_pkg};
243        }
244    }
245    else {
246        $init = $c->registry( "applications", $app->id, "init_request" );
247    }
248    if ( $init && !ref($init) ) {
249        $init = MT->handler_to_coderef($init);
250    }
251    if ( ref $init eq 'CODE' ) {
252        local $MT::plugin_registry = $c->{registry};
253        $init->( $app, @_ );
254    }
255}
256
257sub _getset {
258    my $c = shift;
259    my ($prop) = @_;
260    if ( exists $c->{registry}{$prop} ) {
261        if ( @_ > 1 ) {
262            return $c->{registry}{$prop} = $_[1];
263        }
264        else {
265            my $out = $c->{registry}{$prop};
266
267            # Handle reference to another YAML file
268            # (ie, app-cms.yaml/tags.yaml/etc.)
269            if ( defined($out) && !ref($out) && ( $out =~ m/^[-\w]+\.yaml$/ ) )
270            {
271                my $r = $c->load_registry($out);
272                if ($r) {
273                    return $c->{registry}{$prop} = $r;
274                }
275                return undef;
276            }
277            return $out;
278        }
279    }
280    return @_ > 1 ? $c->{$prop} = $_[1] : $c->{$prop};
281}
282
283sub _getset_translate {
284    my $c = shift;
285    my ($p) = @_;
286    if ( !$p ) {
287        $p = ( caller(1) )[3];
288        $p =~ s/.*:://;
289    }
290    my $return;
291    if ( exists $c->{registry}{$p} ) {
292        $return = @_ > 1 ? $c->{registry}{$p} = $_[1] : $c->{registry}{$p};
293    }
294    else {
295        $return = @_ > 1 ? $c->{$p} = $_[1] : $c->{$p};
296    }
297    return $c->l10n_filter( defined $return ? $return : '' );
298}
299
300sub name { &_getset_translate }
301
302sub label {
303    my $c = shift;
304    return $c->_getset('label') || $c->name();
305}
306
307sub description { &_getset_translate }
308
309sub needs_upgrade {
310    my $c  = shift;
311    my $sv = $c->schema_version;
312    return 0 unless defined $sv;
313    my $key     = 'PluginSchemaVersion';
314    my $id      = $c->id;
315    my $ver     = MT->config($key);
316    my $cfg_ver = $ver->{$id} if $ver;
317    if ( ( !defined $cfg_ver ) || ( $cfg_ver < $sv ) ) {
318        return 1;
319    }
320    0;
321}
322
323sub template_paths {
324    my $c = shift;
325
326    my $mt   = MT->instance;
327    my $path = $mt->config('TemplatePath');
328
329    my @paths;
330    my $dir = File::Spec->catdir( $c->path, 'tmpl' );
331    push @paths, $dir if -d $dir;
332    $dir = $c->path;
333    push @paths, $dir if -d $dir;
334    if ( my $alt_path = $mt->config('AltTemplatePath') ) {
335        if ( -d $alt_path ) {    # AltTemplatePath is absolute
336            push @paths, File::Spec->catdir( $alt_path, $mt->{template_dir} )
337              if $mt->{template_dir};
338            push @paths, $alt_path;
339        }
340    }
341    push @paths, File::Spec->catdir( $path, $mt->{template_dir} )
342      if $mt->{template_dir};
343    push @paths, $path;
344    return @paths;
345}
346
347sub load_tmpl {
348    my $c = shift;
349    my ($file, $param) = @_;
350
351    my $mt = MT->instance;
352    my $type = { 'SCALAR' => 'scalarref', 'ARRAY' => 'arrayref' }->{ ref $file }
353      || 'filename';
354
355    require MT::Template;
356    my $tmpl = MT::Template->new(
357        type   => $type,
358        source => $file,
359        path   => [ $c->template_paths ],
360        ($mt->isa('MT::App') ? ( filter => sub {
361            my ($str, $fname) = @_;
362            if ($fname) {
363                $fname = File::Basename::basename($fname);
364                $fname =~ s/\.tmpl$//;
365                $mt->run_callbacks("template_source.$fname", $mt, @_);
366            } else {
367                $mt->run_callbacks("template_source", $mt, @_);
368            }
369            return $str;
370        }) : ()),
371    );
372    return $c->error(
373        $mt->translate( "Loading template '[_1]' failed: [_2]", $file, MT::Template->errstr ) )
374      unless defined $tmpl;
375    my $text = $tmpl->text;
376    if (($text =~ m/<(mt|_)_trans/i) && ($c->id)) {
377        $tmpl->text( '<__trans_section component="' . $c->id . '">' . $text . '</__trans_section>');
378    }
379    $tmpl->{__file} = $file if $type eq 'filename';
380
381    ## We do this in load_tmpl because show_error and login don't call
382    ## build_page; so we need to set these variables here.
383    $mt->set_default_tmpl_params($tmpl);
384    $tmpl->param($param) if $param;
385
386    return $tmpl;
387}
388
389sub l10n_class { _getset( shift, 'l10n_class', @_ ) || 'MT::L10N' }
390
391sub translate {
392    my $c       = shift;
393    my $handles = MT->request('l10n_handle') || {};
394    my $h       = $handles->{ $c->id };
395    unless ($h) {
396        my $lang = MT->current_language || MT->config->DefaultLanguage;
397        eval "require " . $c->l10n_class . ";";
398        if ($@) {
399            $h = MT->language_handle;
400        }
401        else {
402            $h = $c->l10n_class->get_handle($lang);
403        }
404        $handles->{ $c->id } = $h;
405        MT->request( 'l10n_handle', $handles );
406    }
407    my ( $format, @args ) = @_;
408    foreach (@args) {
409        $_ = $_->() if ref($_) eq 'CODE';
410    }
411    my $enc = MT->instance->config('PublishCharset');
412    my $str;
413    if ($h) {
414        if ( $enc =~ m/utf-?8/i ) {
415            $str = $h->maketext( $format, @args );
416        }
417        else {
418            $str = MT::I18N::encode_text(
419                $h->maketext(
420                    $format,
421                    map { MT::I18N::encode_text( $_, $enc, 'utf-8' ) } @args
422                ),
423                'utf-8', $enc
424            );
425        }
426    }
427    if ( !defined $str ) {
428        $str = MT->translate(@_);
429    }
430    $str;
431}
432
433sub translate_templatized {
434    my $c = shift;
435    my ($text) = @_;
436    my @cstack;
437    while (1) {
438        $text =~ s!(<(/)?(?:_|MT)_TRANS(_SECTION)?(?:(?:\s+((?:\w+)\s*=\s*(["'])(?:(<(?:[^"'>]|"[^"]*"|'[^']*')+)?>|[^\5]+?)*?\5))+?\s*/?)?>)!
439        my($msg, $close, $section, %args) = ($1, $2, $3);
440        while ($msg =~ /\b(\w+)\s*=\s*(["'])((?:<(?:[^"'>]|"[^"]*"|'[^']*')+?>|[^\2])*?)?\2/g) {  #"
441            $args{$1} = $3;
442        }
443        if ($section) {
444            if ($close) {
445                $c = pop @cstack;
446            } else {
447                if ($args{component}) {
448                    push @cstack, $c;
449                    $c = MT->component($args{component});
450                }
451                else {
452                    die "__trans_section without a component argument";
453                }
454            }
455            '';
456        } else {
457            $args{params} = '' unless defined $args{params};
458            my @p = map MT::Util::decode_html($_),
459                    split /\s*%%\s*/, $args{params}, -1;
460            @p = ('') unless @p;
461            my $translation = $c->translate($args{phrase}, @p);
462            if (exists $args{escape}) {
463                if (lc($args{escape}) eq 'html') {
464                    $translation = encode_html($translation);
465                } elsif (lc($args{escape}) eq 'url') {
466                    $translation = MT::Util::encode_url($translation);
467                } else {
468                    # fallback for js/javascript/singlequotes
469                    $translation = encode_js($translation);
470                }
471            }
472            $translation;
473        }
474        !igem or last;
475    }
476    return $text;
477}
478
479sub l10n_filter { $_[0]->translate_templatized( $_[1] ) }
480
481# can be invoked statically or with an instance.
482# if invoked statically, it queries all available plugins
483#   MT::Plugin->registry("applications")
484# if invoked with an instance, it only selects for that plugin's registry
485#   $foo_plugin->registry("applications")
486
487sub registry {
488    my $c = shift;
489    if ( ref $c ) {
490        if ( !@_ ) { return $c->{registry} ||= {} }
491        if ( ref $_[0] ) {
492            return $c->{registry} = shift;
493        }
494        my @path = @_;
495        my $r    = $c->{registry};
496        return undef unless $r;
497        my ( $last_r, $last_p );
498        foreach my $p (@path) {
499            if ( ref $p ) {
500
501                # Handle the case where an assignment
502                # is being made to a registry item. Ie
503                # $comp->registry("foo","bar","baz", { stuff => ... })
504                $last_r->{$last_p} = $p;
505                $r = $last_r;
506                last;
507            }
508            if ( exists $r->{$p} ) {
509                my $v = $r->{$p};
510
511                # check for a yaml file reference...
512                if ( !ref($v) && ( $v =~ m/^[-\w]+\.yaml$/ ) ) {
513                    my $f = File::Spec->catfile( $c->path, $v );
514                    if ( -f $f ) {
515                        require YAML::Tiny;
516                        my $y = eval { YAML::Tiny->read($f) }
517                            or die "Error reading $f: " . $YAML::Tiny::errstr;
518
519                        # skip over non-hash elements
520                        shift @$y while @$y && ( ref( $y->[0] ) ne 'HASH' );
521                        if (@$y) {
522                            $r->{$p} = $y->[0];
523                        }
524                    }
525                }
526                elsif ( ref($v) eq 'CODE' ) {
527                    $r->{$p} = $v->($c);
528                }
529                $last_r = $r;
530                $last_p = $p;
531                $r      = $r->{$p};
532            }
533            else {
534                return undef;
535            }
536        }
537
538        # deepscan for any label elements since they will need translation
539        if ( ref $r eq 'HASH' ) {
540            __deep_localize_labels( $c, $r );
541            weaken($_->{plugin} = $c)
542                for grep { ref $_ eq 'HASH' } values %$r;
543        }
544
545        # $r should now be the element of the path requested
546        return $r;
547    }
548    else {
549        my @objs = $c->select();
550        my @list;
551        foreach my $o (@objs) {
552            my $r = $o->registry(@_);
553            push @list, $r if defined $r;
554        }
555        return @list ? \@list : undef;
556    }
557}
558
559sub __deep_localize_labels {
560    my ( $c, $hash ) = @_;
561    foreach my $k ( keys %$hash ) {
562        if ( ref( $hash->{$k} ) eq 'HASH' ) {
563            __deep_localize_labels( $c, $hash->{$k} );
564        }
565        else {
566            next unless $k =~ m/(?:\b|_)label\b/;
567            if ( !ref( my $label = $hash->{$k} ) ) {
568                $hash->{$k} = sub { $c->translate($label) };
569            }
570        }
571    }
572}
573
5741;
575__END__
576
577=head1 NAME
578
579MT::Component - Movable Type class that describes a component.
580
581=head1 SYNOPSIS
582
583=head1 DESCRIPTION
584
585=head1 ARGUMENTS
586
587=over 4
588
589=item * id (recommended)
590
591=item * label
592
593=item * version
594
595The version number for the release of the plugin. Will be displayed
596next to the plugin's name wherever listed. This information is not
597required, but recommended.
598
599=item * schema_version
600
601If your plugin declares a list of object classes, the schema_version
602is used to determine whether your classes require installation or
603upgrade. MT will store your plugin's schema_version in the C<MT::Config>
604table for future reference.
605
606=back
607
608=head1 METHODS
609
610=head1 LOCALIZATION
611
612=head1 AUTHOR & COPYRIGHT
613
614Please see L<MT/AUTHOR & COPYRIGHT>.
615
616=cut
Note: See TracBrowser for help on using the browser.