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

Revision 1823, 105.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;
8
9use strict;
10use base qw( MT::ErrorHandler );
11use File::Spec;
12use File::Basename;
13use MT::Util qw( weaken );
14use MT::I18N qw( encode_text );
15
16our ( $VERSION,      $SCHEMA_VERSION );
17our ( $PRODUCT_NAME, $PRODUCT_CODE, $PRODUCT_VERSION, $VERSION_ID );
18our ( $MT_DIR,       $APP_DIR, $CFG_DIR, $CFG_FILE, $SCRIPT_SUFFIX );
19our (
20    $plugin_sig, $plugin_envelope, $plugin_registry,
21    %Plugins,    @Components,      %Components,
22    $DebugMode,  $mt_inst,         %mt_inst
23);
24my %Text_filters;
25
26# For state determination in MT::Object
27our $plugins_installed;
28
29BEGIN {
30    $plugins_installed = 0;
31
32    ( $VERSION, $SCHEMA_VERSION ) = ( '__API_VERSION__', '__SCHEMA_VERSION__' );
33    ( $PRODUCT_NAME, $PRODUCT_CODE, $PRODUCT_VERSION, $VERSION_ID ) = (
34        '__PRODUCT_NAME__',    '__PRODUCT_CODE__',
35        '__PRODUCT_VERSION__', '__PRODUCT_VERSION_ID__'
36    );
37
38    $DebugMode = 0;
39
40    # Alias lowercase to uppercase package; note: this is an equivalence
41    # as opposed to having @mt::ISA set to 'MT'. so @mt::Plugins would
42    # resolve as well as @MT::Plugins.
43    *{mt::} = *{MT::};
44
45    # Alias these; Components is the preferred array for MT 4
46    *Plugins = \@Components;
47}
48
49# On-demand loading of compatibility module, if a plugin asks for it, using
50#     use MT 3;
51# or even specific to minor version (but this just loads MT::Compat::v3)
52#     use MT 3.3;
53sub VERSION {
54    my $v = $_[1];
55    if ( defined $v && ( $v =~ m/^(\d+)/ ) ) {
56        my $compat = "MT::Compat::v" . $1;
57        if ( ( $1 > 2 ) && ( $1 < int($VERSION) ) ) {
58            no strict 'refs';
59            unless ( defined *{ $compat . '::' } ) {
60                eval "require $compat;";
61            }
62        }
63    }
64    return UNIVERSAL::VERSION(@_);
65}
66
67sub version_number  { $VERSION }
68sub version_id      { $VERSION_ID }
69sub product_code    { $PRODUCT_CODE }
70sub product_name    { $PRODUCT_NAME }
71sub product_version { $PRODUCT_VERSION }
72sub schema_version  { $SCHEMA_VERSION }
73
74# Default id method turns MT::App::CMS => cms; Foo::Bar => foo/bar
75sub id {
76    my $pkg = shift;
77    my $id = ref($pkg) || $pkg;
78    # ignore the MT::App prefix as part of the identifier
79    $id =~ s/^MT::App:://;
80    $id =~ s!::!/!g;
81    return lc $id;
82}
83
84sub version_slug {
85    return MT->translate_templatized(<<"SLUG");
86<MT_TRANS phrase="Powered by [_1]" params="$PRODUCT_NAME">
87<MT_TRANS phrase="Version [_1]" params="$VERSION_ID">
88<MT_TRANS phrase="http://www.sixapart.com/movabletype/">
89SLUG
90}
91
92sub import {
93    my $pkg = shift;
94    return unless @_;
95
96    my (%param) = @_;
97    my $app_pkg;
98    if ( $app_pkg = $param{app} || $param{App} || $ENV{MT_APP} ) {
99        if ( $app_pkg !~ m/::/ ) {
100            my $apps = $pkg->registry('applications');
101            $app_pkg = $apps->fetch($app_pkg);
102            if ( ref $app_pkg ) {
103
104                # pick first one??
105                $app_pkg = $app_pkg->[0];
106
107                # pick last one??
108                # $app_pkg = pop @$app_pkg;
109            }
110        }
111    }
112    elsif ( $param{run} || $param{Run} ) {
113
114        # my $script = File::Spec->rel2abs($0);
115        my ( $filename, $path, $suffix ) = fileparse( $0, qr{\..+$} );
116        $SCRIPT_SUFFIX = $suffix;
117        my $script = lc $filename;
118        $script =~ s/^mt-//;
119        my $apps = $pkg->registry('applications');
120        $app_pkg = $apps->fetch( lc $script );
121        unless ($app_pkg) {
122            die "cannot determine application for script $0, stopped at";
123        }
124    }
125    $pkg->run_app( $app_pkg, \%param )
126      if $app_pkg;
127}
128
129sub run_app {
130    my $pkg = shift;
131    my ( $class, $param ) = @_;
132
133    # When running under FastCGI, the initial invocation of the
134    # script has a bare environment. We can use this to test
135    # for FastCGI.
136    my $not_fast_cgi = 0;
137    $not_fast_cgi ||= exists $ENV{$_}
138      for qw(HTTP_HOST GATEWAY_INTERFACE SCRIPT_FILENAME SCRIPT_URL);
139    my $fast_cgi = ( !$not_fast_cgi ) || $param->{fastcgi};
140    $fast_cgi =
141      defined( $param->{fastcgi} || $param->{FastCGI} )
142      ? ( $param->{fastcgi} || $param->{FastCGI} )
143      : $fast_cgi;
144    if ($fast_cgi) {
145        eval { require CGI::Fast; };
146        $fast_cgi = 0 if $@;
147    }
148
149    # ready to run now... run inside an eval block so we can gracefully
150    # die if something bad happens
151    my $app;
152    eval {
153        eval "require $class; 1;" or die $@;
154        if ($fast_cgi) {
155            while ( my $cgi = new CGI::Fast ) {
156                $app = $class->new( %$param, CGIObject => $cgi )
157                  or die $class->errstr;
158                local $SIG{__WARN__} = sub { $app->trace( $_[0] ) };
159                $pkg->set_instance($app);
160                $app->init_request( CGIObject => $cgi );
161                $app->run;
162            }
163        }
164        else {
165            $app = $class->new(%$param) or die $class->errstr;
166            local $SIG{__WARN__} = sub { $app->trace( $_[0] ) };
167            $app->run;
168        }
169    };
170    if ( my $err = $@ ) {
171        my $charset = 'utf-8';
172        eval {
173            $app ||= MT->instance;
174            my $cfg = $app->config;
175            my $c   = $app->find_config;
176            $cfg->read_config($c);
177            $charset = $cfg->PublishCharset;
178        };
179        if ( $app && UNIVERSAL::isa( $app, 'MT::App' ) ) {
180            eval {
181                my %param = ( error => $err );
182                if ( $err =~ m/Bad ObjectDriver/ ) {
183                    $param{error_database_connection} = 1;
184                }
185                elsif ( $err =~ m/Bad CGIPath/ ) {
186                    $param{error_cgi_path} = 1;
187                }
188                elsif ( $err =~ m/Missing configuration file/ ) {
189                    $param{error_config_file} = 1;
190                }
191                my $page = $app->build_page( 'error.tmpl', \%param )
192                  or die $app->errstr;
193                print "Content-Type: text/html; charset=$charset\n\n";
194                print $page;
195            };
196            if ( my $err = $@ ) {
197                print "Content-Type: text/plain; charset=$charset\n\n";
198                print $app
199                  ? $app->translate( "Got an error: [_1]", $err )
200                  : "Got an error: $err";
201            }
202        }
203        else {
204            if ( $err =~ m/Missing configuration file/ ) {
205                my $host = $ENV{SERVER_NAME} || $ENV{HTTP_HOST};
206                $host =~ s/:\d+//;
207                my $port = $ENV{SERVER_PORT};
208                my $uri = $ENV{REQUEST_URI} || $ENV{PATH_INFO};
209                $uri =~ s/mt(\Q$SCRIPT_SUFFIX\E)?.*$//;
210                my $cgipath = '';
211                $cgipath = $port == 443 ? 'https' : 'http';
212                $cgipath .= '://' . $host;
213                $cgipath .= ( $port == 443 || $port == 80 ) ? '' : ':' . $port;
214                $cgipath .= $uri;
215
216                print "Status: 302 Moved\n";
217                print "Location: " . $cgipath . "mt-wizard.cgi\n\n";
218            }
219            else {
220                print "Content-Type: text/plain; charset=$charset\n\n";
221                print $app
222                  ? $app->translate( "Got an error: [_1]", $err )
223                  : "Got an error: $err\n";
224            }
225        }
226    }
227}
228
229sub app {
230    my $class = shift;
231    $mt_inst ||= $mt_inst{$class} ||= $class->construct(@_);
232}
233*instance = *app;
234
235sub set_instance {
236    my $class = shift;
237    $mt_inst = shift;
238}
239
240sub new {
241    my $mt = &instance_of;
242    $mt_inst ||= $mt;
243    $mt;
244}
245
246sub instance_of {
247    my $class = shift;
248    $mt_inst{$class} ||= $class->construct(@_);
249}
250
251sub construct {
252    my $class = shift;
253    my $mt = bless {}, $class;
254    local $mt_inst = $mt;
255    $mt->init(@_)
256      or die $mt->errstr;
257    $mt;
258}
259
260{
261    my %object_types;
262
263    sub model {
264        my $pkg = shift;
265        my ($k) = @_;
266        $object_types{$k} = $_[1] if scalar @_ > 1;
267        return $object_types{$k} if exists $object_types{$k};
268
269        my $model = $pkg->registry( 'object_types', $k );
270        if ( ref($model) eq 'ARRAY' ) {
271
272            # First element of an array *should* be a scalar; in case it isn't,
273            # return undef.
274            $model = $model->[0];
275            return undef if ref $model;
276        }
277        elsif ( ref($model) eq 'HASH' ) {
278
279            # If all we have is a hash, this doesn't tell us the package for
280            # this object type, so it's undefined.
281            return undef;
282        }
283        return undef unless $model;
284
285        # Element in object type hash is scalar, so return it
286        no strict 'refs';
287        unless ( defined *{ $model . '::__properties' } ) {
288            use strict 'refs';
289            eval "require $model;";
290            if ( $@ && ( $k =~ m/^(.+)\./ ) ) {
291
292                # x.foo can't be found, so try loading x
293                if ( my $ppkg = $pkg->model($1) ) {
294
295                    # well now see if $model is defined
296                    no strict 'refs';
297                    unless ( defined *{ $model . '::__properties' } ) {
298
299                        # if not, use parent package instead
300                        $model = $ppkg;
301                    }
302                }
303            }
304        }
305        return $object_types{$k} = $model;
306    }
307
308    sub models {
309        my $pkg = shift;
310        my ($k) = @_;
311
312        my @matches;
313        my $model = $pkg->registry('object_types');
314        foreach my $m ( keys %$model ) {
315            if ( $m =~ m/^\Q$k\E\.?/ ) {
316                push @matches, $m;
317            }
318        }
319        return @matches;
320    }
321}
322
323sub registry {
324    my $pkg = shift;
325
326    # if (!ref $pkg) {
327    #     return $pkg->instance->registry(@_);
328    # }
329    require MT::Component;
330    my $regs = MT::Component->registry(@_);
331    my $r;
332    if ($regs) {
333        foreach my $cr (@$regs) {
334
335            # in the event that our registry request returns something
336            # other than an array of hashes, return it as is instead of
337            # merging it together.
338            return $regs unless ref($cr) eq 'HASH';
339
340            # next unless ref($cr) eq 'HASH';
341            delete $cr->{plugin} if exists $cr->{plugin};
342            __merge_hash( $r ||= {}, $cr );
343        }
344    }
345    return $r;
346}
347
348# merges contents of two hashes, giving preference to the right side
349# if $replace is true; otherwise it will always append to the left side.
350sub __merge_hash {
351    my ( $h1, $h2, $replace ) = @_;
352    for my $k ( keys(%$h2) ) {
353        if ( exists( $h1->{$k} ) && ( !$replace ) ) {
354            if ( ref $h1->{$k} eq 'HASH' ) {
355                __merge_hash( $h1->{$k}, $h2->{$k}, ( $replace || 0 ) + 1 );
356            }
357            elsif ( ref $h1->{$k} eq 'ARRAY' ) {
358                if ( ref $h2->{$k} eq 'ARRAY' ) {
359                    push @{ $h1->{$k} }, @{ $h2->{$k} };
360                }
361                else {
362                    push @{ $h1->{$k} }, $h2->{$k};
363                }
364            }
365            else {
366                $h1->{$k} = [ $h1->{$k}, $h2->{$k} ];
367            }
368        }
369        else {
370            $h1->{$k} = $h2->{$k};
371        }
372    }
373}
374
375# The above functions can all be used to make MT objects (and subobjects).
376# The difference between them is characterized by these assertions:
377#
378#  $mt = MT::App::Search->new();
379#  assert($mt->isa('MT::App::Search'))
380#
381#  $mt1 = MT->instance
382#  $mt2 = MT->instance
383#  assert($mt1 == $mt2);
384#
385#  $mt1 = MT::App::CMS->construct()
386#  $mt2 = MT::App::CMS->construct()
387#  assert($mt1 != $mt2);
388#
389# TBD: make a test script for these.
390
391sub unplug {
392}
393
394sub config {
395    my $mt = shift;
396    ref $mt or $mt = MT->instance;
397    unless ( $mt->{cfg} ) {
398        require MT::ConfigMgr;
399        weaken( $mt->{cfg} = MT::ConfigMgr->instance );
400    }
401    if (@_) {
402        my $setting = shift;
403        @_ ? $mt->{cfg}->set( $setting, @_ ) : $mt->{cfg}->get($setting);
404    }
405    else {
406        $mt->{cfg};
407    }
408}
409
410sub request {
411    my $pkg  = shift;
412    my $inst = ref($pkg) ? $pkg : $pkg->instance;
413    unless ( $inst->{request} ) {
414        require MT::Request;
415        $inst->{request} = MT::Request->instance;
416    }
417    if (@_) {
418        $inst->{request}->stash(@_);
419    }
420    else {
421        $inst->{request};
422    }
423}
424
425sub log {
426    my $mt = shift;
427    unless ($plugins_installed) {
428        # finish init_schema here since we have to log something
429        # to the database.
430        $mt->init_schema();
431    }
432    my $msg;
433    if ( !@_ ) {    # single parameter to log, so $mt must be message
434        $msg = $mt;
435        $mt  = MT->instance;
436    }
437    else {          # multiple parameters to log; second one is message
438        $msg = shift;
439    }
440    my $log_class = $mt->model('log');
441    my $log = $log_class->new();
442    if ( ref $msg eq 'HASH' ) {
443        $log->set_values($msg);
444    }
445    elsif ( ( ref $msg ) && ( UNIVERSAL::isa( $msg, 'MT::Log' ) ) ) {
446        $log = $msg;
447    }
448    else {
449        $log->message($msg);
450    }
451    $log->level( MT::Log::INFO() )
452      unless defined $log->level;
453    $log->class('system')
454      unless defined $log->class;
455    $log->save();
456    print STDERR MT->translate( "Message: [_1]", $log->message ) . "\n"
457      if $MT::DebugMode;
458}
459my $plugin_full_path;
460
461sub run_tasks {
462    my $mt = shift;
463    require MT::TaskMgr;
464    MT::TaskMgr->run_tasks(@_);
465}
466
467sub add_plugin {
468    my $class = shift;
469    my ($plugin) = @_;
470    if ( ref $plugin eq 'HASH' ) {
471        require MT::Plugin;
472        $plugin = new MT::Plugin($plugin);
473    }
474    $plugin->{name} ||= $plugin_sig;
475    $plugin->{plugin_sig} = $plugin_sig;
476
477    my $id = $plugin->id;
478    unless ($plugin_envelope) {
479        warn "MT->add_plugin improperly called outside of MT plugin load loop.";
480        return;
481    }
482    $plugin->envelope($plugin_envelope);
483    Carp::confess("You cannot register multiple plugin objects from a single script. $plugin_sig")
484      if exists( $Plugins{$plugin_sig} )
485      && ( exists $Plugins{$plugin_sig}{object} );
486
487    $Components{ lc $id } = $plugin if $id;
488    $Plugins{$plugin_sig}{object} = $plugin;
489    $plugin->{full_path}  = $plugin_full_path;
490    $plugin->path($plugin_full_path);
491    unless ( $plugin->{registry} && ( %{ $plugin->{registry} } ) ) {
492        $plugin->{registry} = $plugin_registry;
493    }
494    if ( $plugin->{registry} ) {
495        if ( my $settings = $plugin->{registry}{config_settings} ) {
496            $settings = $plugin->{registry}{config_settings} = $settings->()
497              if ref($settings) eq 'CODE';
498            $class->config->define($settings);
499        }
500    }
501    push @Components, $plugin;
502    1;
503}
504
505our %CallbackAlias;
506our $CallbacksEnabled = 1;
507my %CallbacksEnabled;
508my @Callbacks;
509
510sub add_callback {
511    my $class = shift;
512    my ( $meth, $priority, $plugin, $code ) = @_;
513    if ( $meth =~ m/^(.+::)?([^\.]+)(\..+)?$/ ) {
514
515        # Remap (whatever)::(name).(something)
516        if ( exists $CallbackAlias{$2} ) {
517            $meth = $CallbackAlias{$2};
518            $meth = $1 . $meth if $1;
519            $meth = $meth . $3 if $3;
520        }
521    }
522    $meth = $CallbackAlias{$meth} if exists $CallbackAlias{$meth};
523    my $internal = 0;
524    if ( ref $plugin ) {
525        if ( ( defined $mt_inst ) && ( $plugin == $mt_inst ) ) {
526            $plugin   = undef;
527            $internal = 1;
528        }
529        elsif ( !UNIVERSAL::isa( $plugin, "MT::Component" ) ) {
530            return $class->trans_error(
531"If present, 3rd argument to add_callback must be an object of type MT::Component or MT::Plugin"
532            );
533        }
534    }
535    if ( ( ref $code ) ne 'CODE' ) {
536        if ( ref $code ) {
537            return $class->trans_error(
538                '4th argument to add_callback must be a CODE reference.');
539        }
540        else {
541            # Defer until callback is used
542            # if ($plugin) {
543            #     $code = MT->handler_to_coderef($code);
544            # }
545        }
546    }
547
548    # 0 and 11 are exclusive.
549    if ( $priority == 0 || $priority == 11 ) {
550        if ( $Callbacks[$priority]->{$meth} ) {
551            return $class->trans_error("Two plugins are in conflict");
552        }
553    }
554    return $class->trans_error( "Invalid priority level [_1] at add_callback",
555        $priority )
556      if ( ( $priority < 0 ) || ( $priority > 11 ) );
557    require MT::Callback;
558    $CallbacksEnabled{$meth} = 1;
559    ## push @{$Plugins{$plugin_sig}{callbacks}}, "$meth Callback" if $plugin_sig;
560    my $cb = new MT::Callback(
561        plugin   => $plugin,
562        code     => $code,
563        priority => $priority,
564        internal => $internal,
565        method   => $meth
566    );
567    push @{ $Callbacks[$priority]->{$meth} }, $cb;
568    $cb;
569}
570
571sub remove_callback {
572    my $class    = shift;
573    my ($cb)     = @_;
574    my $priority = $cb->{priority};
575    my $method   = $cb->{method};
576    my $list     = $Callbacks[$priority];
577    return unless $list;
578    my $cbarr = $list->{$method};
579    return unless $cbarr;
580    @$cbarr = grep { $_ != $cb } @$cbarr;
581}
582
583# For use by MT internal code
584sub _register_core_callbacks {
585    my $class = shift;
586    my ($callback_table) = @_;
587    foreach my $name ( keys %$callback_table ) {
588        $class->add_callback( $name, 5, $mt_inst, $callback_table->{$name} )
589          || return;
590    }
591    1;
592}
593
594sub register_callbacks {
595    my $class = shift;
596    my ($callback_list) = @_;
597    foreach my $cb (@$callback_list) {
598        $class->add_callback( $cb->{name}, $cb->{priority}, $cb->{plugin},
599            $cb->{code} )
600          || return;
601    }
602    1;
603}
604
605our $CB_ERR;
606sub callback_error { $CB_ERR = $_[0]; }
607sub callback_errstr { $CB_ERR }
608
609sub run_callback {
610    my $class = shift;
611    my ( $cb, @args ) = @_;
612
613    $cb->error();    # reset the error string
614    my $result = eval { $cb->invoke(@args) };
615    if ( my $err = $@ ) {
616        $cb->error($err);
617        my $plugin = $cb->{plugin};
618        my $name;
619        if ( $cb->{internal} ) {
620            $name = "Internal callback";
621        }
622        elsif ( UNIVERSAL::isa( $plugin, 'MT::Plugin' ) ) {
623            $name = $plugin->name() || MT->translate("Unnamed plugin");
624        }
625        else {
626            $name = MT->translate("Unnamed plugin");
627        }
628        require MT::Log;
629        MT->log(
630            {
631                message => MT->translate( "[_1] died with: [_2]", $name, $err ),
632                class   => 'system',
633                category => 'callback',
634                level    => MT::Log::ERROR(),
635            }
636        );
637        return 0;
638    }
639    if ( $cb->errstr() ) {
640        return 0;
641    }
642    return $result;
643}
644
645# A callback should return a true/false value. The result of
646# run_callbacks is the logical AND of all the callback's return
647# values. Some hookpoints will ignore the return value: e.g. object
648# callbacks don't use it. By convention, those that use it have Filter
649# at the end of their names (CommentPostFilter, CommentThrottleFilter,
650# etc.)
651# Note: this composition is not short-circuiting. All callbacks are
652# executed even if one has already returned false.
653# ALSO NOTE: failure (dying or setting $cb->errstr) does not force a
654# "false" return.
655# THINK: are there cases where a true value should override all false values?
656# that is, where logical OR is the right way to compose multiple callbacks?
657sub run_callbacks {
658    my $class = shift;
659    my ( $meth, @args ) = @_;
660    return 1 unless $CallbacksEnabled && %CallbacksEnabled;
661    $meth = $CallbackAlias{$meth} if exists $CallbackAlias{$meth};
662    my @methods;
663
664    # execution:
665    #   Full::Name.<variant>
666    #   *::Name.<variant> OR Name.<variant>
667    #   Full::Name
668    #   *::Name OR Name
669    push @methods, $meth if $CallbacksEnabled{$meth};    # bleh::blah variant
670    if ( $meth =~ /::/ ) {    # presence of :: implies it's an obj. cb
671        my $name = $meth;
672        $name =~ s/^.*::([^:]*)$/$1/;
673        $name = $CallbackAlias{ '*::' . $name }
674          if exists $CallbackAlias{ '*::' . $name };
675        push @methods, '*::' . $name
676          if $CallbacksEnabled{ '*::' . $name };    # *::blah variant
677        push @methods, $name if $CallbacksEnabled{$name};    # blah variant
678    }
679    if ( $meth =~ /\./ ) {    # presence of ' ' implies it is a variant callback
680        my ($name) = split /\./, $meth, 2;
681        $name = $CallbackAlias{$name} if exists $CallbackAlias{$name};
682        push @methods, $name if $CallbacksEnabled{$name};    # bleh::blah
683        if ( $name =~ m/::/ ) {
684            my $name2 = $name;
685            $name2 =~ s/^.*::([^:]*)$/$1/;
686            $name2 = $CallbackAlias{ '*::' . $name2 }
687              if exists $CallbackAlias{ '*::' . $name2 };
688            push @methods, '*::' . $name2
689              if $CallbacksEnabled{ '*::' . $name2 };        # *::blah
690            push @methods, $name2 if $CallbacksEnabled{$name2};    # blah
691        }
692    }
693    return 1 unless @methods;
694
695    $CallbacksEnabled{$_} = 0 for @methods;
696    my @errors;
697    my $filter_value = 1;
698    my $first_error;
699
700    foreach my $callback_sheaf (@Callbacks) {
701        for my $meth (@methods) {
702            if ( my $set = $callback_sheaf->{$meth} ) {
703                for my $cb (@$set) {
704                    my $result = $class->run_callback( $cb, @args );
705                    $filter_value &&= $result;
706                    if ( !$result ) {
707                        if ( $cb->errstr() ) {
708                            push @errors, $cb->errstr();
709                        }
710                        if ( !defined($first_error) ) {
711                            $first_error = $cb->errstr();
712                        }
713                    }
714                }
715            }
716        }
717    }
718
719    callback_error( join( '', @errors ) );
720
721    $CallbacksEnabled{$_} = 1 for @methods;
722    if ( !$filter_value ) {
723        return $class->error($first_error);
724    }
725    else {
726        return $filter_value;
727    }
728}
729
730sub user_class {
731    shift->{user_class};
732}
733
734sub find_config {
735    my $mt = shift;
736    my ($param) = @_;
737
738    $param->{Config}    ||= $ENV{MT_CONFIG};
739    $param->{Directory} ||= $ENV{MT_HOME};
740    if ( !$param->{Directory} ) {
741        if ( $param->{Config} ) {
742            $param->{Directory} = dirname( $param->{Config} );
743        }
744        else {
745            $param->{Directory} = dirname($0) || $ENV{PWD} || '.';
746        }
747    }
748
749    # the directory is the more important parameter between it and
750    # the config parameter. if config is unreadable, then scan for
751    # a config file using the directory as a base.  we support
752    # either mt.cfg or mt-config.cgi for the config file name. the
753    # latter being a more secure choice since it is unreadable from
754    # a browser.
755    for my $cfg_file ( $param->{Config},
756        File::Spec->catfile( $param->{Directory}, 'mt-config.cgi' ),
757        'mt-config.cgi' )
758    {
759        return $cfg_file if $cfg_file && -r $cfg_file && -f $cfg_file;
760    }
761    return undef;
762}
763
764sub init_schema {
765    require MT::Object;
766    MT::Object->install_pre_init_properties();
767}
768
769sub init_permissions {
770    require MT::Permission;
771    MT::Permission->init_permissions;
772}
773
774sub init_config {
775    my $mt = shift;
776    my ($param) = @_;
777
778    my $cfg_file = $mt->find_config($param);
779    return $mt->error(
780"Missing configuration file. Maybe you forgot to move mt-config.cgi-original to mt-config.cgi?"
781    ) unless $cfg_file;
782    $cfg_file = File::Spec->rel2abs($cfg_file);
783
784    # translate the config file's location to an absolute path, so we
785    # can use that directory as a basis for calculating other relative
786    # paths found in the config file.
787    my $config_dir = $mt->{config_dir} = dirname($cfg_file);
788
789    # store the mt_dir (home) as an absolute path; fallback to the config
790    # directory if it isn't set.
791    $mt->{mt_dir} =
792      $param->{Directory}
793      ? File::Spec->rel2abs( $param->{Directory} )
794      : $mt->{config_dir};
795    $mt->{mt_dir} ||= dirname($0);
796
797    # also make note of the active application path; this is derived by
798    # checking the PWD environment variable, the dirname of $0,
799    # the directory of SCRIPT_FILENAME and lastly, falls back to mt_dir
800    $mt->{app_dir} = $ENV{PWD} || "";
801    $mt->{app_dir} = dirname($0)
802      if !$mt->{app_dir}
803      || !File::Spec->file_name_is_absolute( $mt->{app_dir} );
804    $mt->{app_dir} = dirname( $ENV{SCRIPT_FILENAME} )
805      if $ENV{SCRIPT_FILENAME}
806      && ( !$mt->{app_dir}
807        || ( !File::Spec->file_name_is_absolute( $mt->{app_dir} ) ) );
808    $mt->{app_dir} ||= $mt->{mt_dir};
809    $mt->{app_dir} = File::Spec->rel2abs( $mt->{app_dir} );
810
811    my $cfg = $mt->config;
812    $cfg->define( $mt->registry('config_settings') );
813    $cfg->read_config($cfg_file) or return $mt->error( $cfg->errstr );
814    $mt->{cfg_file} = $cfg_file;
815
816    my @mt_paths = $cfg->paths;
817    for my $meth (@mt_paths) {
818        my $path = $cfg->get( $meth, undef );
819        my $type = $cfg->type($meth);
820        if ( defined $path ) {
821            if ( $type eq 'ARRAY' ) {
822                my @paths = $cfg->get($meth);
823                local $_;
824                foreach (@paths) {
825                    next if File::Spec->file_name_is_absolute($_);
826                    $_ = File::Spec->catfile( $config_dir, $_ );
827                }
828                $cfg->$meth( \@paths );
829            }
830            else {
831                if ( !File::Spec->file_name_is_absolute($path) ) {
832                    $path = File::Spec->catfile( $config_dir, $path );
833                    $cfg->$meth($path);
834                }
835            }
836        }
837        else {
838            next if $type eq 'ARRAY';
839            my $path = $cfg->default($meth);
840            if ( defined $path ) {
841                $cfg->$meth( File::Spec->catfile( $config_dir, $path ) );
842            }
843        }
844    }
845
846    return $mt->trans_error("Bad ObjectDriver config")
847      unless $cfg->ObjectDriver;
848
849    if ( $MT::DebugMode = $cfg->DebugMode ) {
850        require Data::Dumper;
851        $Data::Dumper::Terse    = 1;
852        $Data::Dumper::Maxdepth = 4;
853        $Data::Dumper::Sortkeys = 1;
854        $Data::Dumper::Indent   = 1;
855    }
856
857    if ($cfg->PerformanceLogging && $cfg->ProcessMemoryCommand) {
858        $mt->log_times();
859    }
860
861    $mt->set_language( $cfg->DefaultLanguage );
862
863    my $cgi_path = $cfg->CGIPath;
864    if ( !$cgi_path || $cgi_path =~ m!http://www\.example\.com/! ) {
865        return $mt->trans_error("Bad CGIPath config");
866    }
867
868    $mt->{cfg} = $cfg;
869
870    1;
871}
872
873{
874my ($memory_start);
875sub log_times {
876    my $pkg = shift;
877
878    my $timer = $pkg->get_timer;
879    return unless $timer;
880
881    my $memory;
882    my $cmd = $pkg->config->ProcessMemoryCommand;
883    if ($cmd) {
884        my $re;
885        if (ref($cmd) eq 'HASH') {
886            $re = $cmd->{regex};
887            $cmd = $cmd->{command};
888        }
889        $cmd =~ s/\$\$/$$/g;
890        $memory = `$cmd`;
891        if ($re) {
892            if ($memory =~ m/$re/) {
893                $memory = $1;
894                $memory =~ s/\D//g;
895            }
896        } else {
897            $memory =~ s/\s+//gs;
898        }
899    }
900
901    # Called at the start of the process; so we're only recording
902    # the memory usage at the start of the app right now.
903    unless ($timer->{elapsed}) {
904        $memory_start = $memory;
905        return;
906    }
907
908    my $log_file;
909
910    # Log filename calcluation; changes daily, so we don't cache this
911    require File::Spec;
912    my $dir = File::Spec->catdir( MT->instance->static_file_path,
913        'support', 'logs');
914    if (! -d $dir) {
915        require File::Path;
916        eval { File::Path::mkpath([$dir], 0, 0777) };
917        if ($@) {
918            $log_file = 0;
919            return;
920        }
921    }
922    my @time = localtime(time);
923    my $file = sprintf("pl-%04d%02d%02d.log", $time[5] + 1900, $time[4]+1, $time[3]);
924    $log_file = File::Spec->catfile( $dir, $file );
925
926    my $first_write = ! -f $log_file;
927
928    local *PERFLOG;
929    open PERFLOG, ">>$log_file";
930    require Fcntl;
931    flock(PERFLOG, Fcntl::LOCK_EX());
932
933    if ($first_write) {
934        require Config;
935        my ($osname, $osvers) = ($Config::Config{osname}, $Config::Config{osvers});
936        print PERFLOG "# Operating System: $osname/$osvers\n";
937        print PERFLOG "# Platform: $^O\n";
938        my $ver = ref($^V) eq 'version' ? $^V->normal : ( $^V ? join('.', unpack 'C*', $^V) : $] );
939        print PERFLOG "# Perl Version: $ver\n";
940        print PERFLOG "# Web Server: $ENV{SERVER_SOFTWARE}\n";
941        require MT::Object;
942        my $driver = MT::Object->driver;
943        if ($driver) {
944            my $dbh = $driver->r_handle;
945            if ($dbh) {
946                my $dbname = $dbh->get_info( 17 ); # SQL_DBMS_NAME
947                my $dbver = $dbh->get_info( 18 ); # SQL_DBMS_VER
948                if ($dbname && $dbver) {
949                    print PERFLOG "# Database: $dbname/$dbver\n";
950                }
951            }
952        }
953        my ($drname, $drh) = each %DBI::installed_drh;
954        print PERFLOG "# Database Library: DBI/" . $DBI::VERSION . "; DBD/" . $drh->{Version} . "\n";
955        if ($ENV{MOD_PERL}) {
956            print PERFLOG "# App Mode: mod_perl\n";
957        }
958        elsif ($ENV{FAST_CGI}) {
959            print PERFLOG "# App Mode: FastCGI\n";
960        }
961        else {
962            print PERFLOG "# App Mode: CGI\n";
963        }
964    }
965
966    if ($memory) {
967        print PERFLOG $timer->dump_line("mem_start=$memory_start", "mem_end=$memory");
968    } else {
969        print PERFLOG $timer->dump_line();
970    }
971
972    close PERFLOG;
973}
974}
975
976sub get_timer {
977    my $mt = shift;
978    $mt = MT->instance unless ref $mt;
979    my $timer = $mt->request('timer');
980    unless ($timer) {
981        my $uri;
982        if ($mt->isa('MT::App')) {
983            $uri = $mt->uri( args => { $mt->param_hash } );
984        }
985        require MT::Util::ReqTimer;
986        $timer = MT::Util::ReqTimer->new( $uri );
987        $mt->request('timer', $timer);
988    }
989    return $timer;
990}
991
992sub time_this {
993    my $mt = shift;
994    my ($str, $code) = @_;
995    my $timer = $mt->get_timer();
996    my $ret;
997    if ($timer) {
998        $timer->pause_partial();
999        $ret = $code->();
1000        $timer->mark($str);
1001    } else {
1002        $ret = $code->();
1003    }
1004    return $ret;
1005}
1006
1007sub init_config_from_db {
1008    my $mt = shift;
1009    my ($param) = @_;
1010    my $cfg = $mt->config;
1011    $cfg->read_config_db();
1012
1013    # Tell any instantiated drivers to reconfigure themselves as necessary
1014    MT::ObjectDriverFactory->configure;
1015
1016    1;
1017}
1018
1019sub bootstrap {
1020    my $pkg = shift;
1021    $pkg->init_paths() or return;
1022    $pkg->init_core()  or return;
1023}
1024
1025sub init_paths {
1026    my $mt = shift;
1027    my ($param) = @_;
1028
1029    # determine MT directory
1030    my ($orig_dir);
1031    require File::Spec;
1032    if ( !( $MT_DIR = $ENV{MT_HOME} ) ) {
1033        if ( $0 =~ m!(.*([/\\]))! ) {
1034            $orig_dir = $MT_DIR = $1;
1035            my $slash = $2;
1036            $MT_DIR =~ s!(?:[/\\]|^)(?:plugins[/\\].*|tools[/\\])$!$slash!;
1037            $MT_DIR = '' if ( $MT_DIR =~ m!^\.?[\\/]$! );
1038        }
1039        else {
1040
1041            # MT_DIR/lib/MT.pm -> MT_DIR/lib -> MT_DIR
1042            $MT_DIR = dirname( dirname( File::Spec->rel2abs(__FILE__) ) );
1043        }
1044        unless ($MT_DIR) {
1045            $orig_dir = $MT_DIR = $ENV{PWD} || '.';
1046            $MT_DIR =~ s!(?:[/\\]|^)(?:plugins[/\\].*|tools[/\\]?)$!!;
1047        }
1048        $ENV{MT_HOME} = $MT_DIR;
1049    }
1050    unshift @INC, File::Spec->catdir( $MT_DIR,   'extlib' );
1051    unshift @INC, File::Spec->catdir( $orig_dir, 'lib' )
1052      if $orig_dir && ( $orig_dir ne $MT_DIR );
1053
1054    $mt->set_language('__BUILD_LANGUAGE__');
1055
1056    if ( my $cfg_file = $mt->find_config($param) ) {
1057        $cfg_file = File::Spec->rel2abs($cfg_file);
1058        $CFG_FILE = $cfg_file;
1059    }
1060    else {
1061        return $mt->trans_error(
1062"Missing configuration file. Maybe you forgot to move mt-config.cgi-original to mt-config.cgi?"
1063        ) if ref($mt);
1064    }
1065
1066    # store the mt_dir (home) as an absolute path; fallback to the config
1067    # directory if it isn't set.
1068    $MT_DIR ||=
1069      $param->{directory}
1070      ? File::Spec->rel2abs( $param->{directory} )
1071      : $CFG_DIR;
1072    $MT_DIR ||= dirname($0);
1073
1074    # also make note of the active application path; this is derived by
1075    # checking the PWD environment variable, the dirname of $0,
1076    # the directory of SCRIPT_FILENAME and lastly, falls back to mt_dir
1077    $APP_DIR = $ENV{PWD} || "";
1078    $APP_DIR = dirname($0)
1079      if !$APP_DIR || !File::Spec->file_name_is_absolute($APP_DIR);
1080    $APP_DIR = dirname( $ENV{SCRIPT_FILENAME} )
1081      if $ENV{SCRIPT_FILENAME}
1082      && ( !$APP_DIR || ( !File::Spec->file_name_is_absolute($APP_DIR) ) );
1083    $APP_DIR ||= $MT_DIR;
1084    $APP_DIR = File::Spec->rel2abs($APP_DIR);
1085
1086    return 1;
1087}
1088
1089sub init_core {
1090    my $mt = shift;
1091    return if exists $Components{'core'};
1092    require MT::Core;
1093    my $c = MT::Core->new( { id => 'core', path => $MT_DIR } )
1094      or die MT::Core->errstr;
1095    $Components{'core'} = $c;
1096
1097    # Additional locale-specific defaults
1098    my $defaults = $c->{registry}{config_settings};
1099    $defaults->{DefaultLanguage}{default} = '__BUILD_LANGUAGE__';
1100    $defaults->{NewsboxURL}{default} = '__NEWSBOX_URL__';
1101    $defaults->{LearningNewsURL}{default} = '__LEARNINGNEWS_URL__';
1102    $defaults->{SupportURL}{default} = '__SUPPORT_URL__';
1103    $defaults->{NewsURL}{default} = '__NEWS_URL__';
1104    #$defaults->{HelpURL}{default} = '__HELP_URL__';
1105    $defaults->{DefaultTimezone}{default} = '__DEFAULT_TIMEZONE__';
1106    $defaults->{TimeOffset}{default} = '__DEFAULT_TIMEZONE__';
1107    $defaults->{MailEncoding}{default} = '__MAIL_ENCODING__';
1108    $defaults->{ExportEncoding}{default} = '__EXPORT_ENCODING__';
1109    $defaults->{LogExportEncoding}{default} = '__LOG_EXPORT_ENCODING__';
1110    $defaults->{CategoryNameNodash}{default} = '__CATEGORY_NAME_NODASH__';
1111    $defaults->{PublishCharset}{default} = '__PUBLISH_CHARSET__';
1112
1113    push @Components, $c;
1114    return 1;
1115}
1116
1117sub init {
1118    my $mt    = shift;
1119    my %param = @_;
1120
1121    $mt->bootstrap() unless $MT_DIR;
1122    $mt->{mt_dir}     = $MT_DIR;
1123    $mt->{config_dir} = $CFG_DIR;
1124    $mt->{app_dir}    = $APP_DIR;
1125
1126    $mt->init_callbacks();
1127
1128    ## Initialize the language to the default in case any errors occur in
1129    ## the rest of the initialization process.
1130    $mt->init_config( \%param ) or return;
1131    $mt->init_addons(@_)       or return;
1132    $mt->init_config_from_db( \%param ) or return;
1133    $mt->init_plugins(@_)       or return;
1134    $plugins_installed = 1;
1135    $mt->init_schema();
1136    $mt->init_permissions();
1137
1138    # Load MT::Log so constants are available
1139    require MT::Log;
1140
1141    return $mt;
1142}
1143
1144sub init_callbacks {
1145    my $mt = shift;
1146    MT->_register_core_callbacks({
1147        'build_file_filter' => sub { MT->publisher->queue_build_file_filter(@_) },
1148        'cms_upload_file' => \&core_upload_file_to_sync,
1149        'api_upload_file' => \&core_upload_file_to_sync,
1150    });
1151}
1152
1153sub core_upload_file_to_sync {
1154    my ($cb, %args) = @_;
1155    MT->upload_file_to_sync(%args);
1156}
1157
1158sub upload_file_to_sync {
1159    my $class = shift;
1160    my (%args) = @_;
1161
1162    # no need to do this unless we're syncing stuff.
1163    return unless MT->config('SyncTarget');
1164
1165    my $url = $args{url};
1166    my $file = $args{file};
1167    return unless -f $file;
1168
1169    my $blog = $args{blog};
1170    my $blog_id = $blog->id;
1171    return unless $blog->publish_queue;
1172
1173    require MT::FileInfo;
1174    my $base_url = $url;
1175    $base_url =~ s!^https?://[^/]+!!;
1176    my $fi = MT::FileInfo->load({ blog_id => $blog_id, url => $base_url });
1177    if (!$fi) {
1178        $fi = new MT::FileInfo;
1179        $fi->blog_id($blog_id);
1180        $fi->url($base_url);
1181        $fi->file_path($file);
1182    } else {
1183        $fi->file_path($file);
1184    }
1185    $fi->save;
1186
1187    require MT::TheSchwartz;
1188    require TheSchwartz::Job;
1189    my $job = TheSchwartz::Job->new();
1190    $job->funcname('MT::Worker::Sync');
1191    $job->uniqkey( $fi->id );
1192    $job->coalesce( ( $fi->blog_id || 0 ) . ':' . $$ . ':' . ( time - ( time % 10 ) ) );
1193    MT::TheSchwartz->insert($job);
1194}
1195
1196sub init_addons {
1197    my $mt = shift;
1198    my $cfg = $mt->config;
1199    my @PluginPaths;
1200
1201    unshift @PluginPaths, File::Spec->catdir( $MT_DIR, 'addons' );
1202    return $mt->_init_plugins_core({}, 1, \@PluginPaths);
1203}
1204
1205sub init_plugins {
1206    my $mt = shift;
1207
1208    # Load compatibility module for prior version
1209    # This should always be MT::Compat::v(MAJOR_RELEASE_VERSION - 1).
1210    require MT::Compat::v3;
1211
1212    require MT::Plugin;
1213    my $cfg          = $mt->config;
1214    my $use_plugins  = $cfg->UsePlugins;
1215    my @PluginPaths  = $cfg->PluginPath;
1216    my $PluginSwitch = $cfg->PluginSwitch || {};
1217    return $mt->_init_plugins_core($PluginSwitch, $use_plugins, \@PluginPaths);
1218}
1219
1220sub _init_plugins_core {
1221    my $mt = shift;
1222    my ($PluginSwitch, $use_plugins, $PluginPaths) = @_;
1223
1224    my $timer;
1225    if ($mt->config->PerformanceLogging) {
1226        $timer = $mt->get_timer();
1227    }
1228
1229    foreach my $PluginPath (@$PluginPaths) {
1230        my $plugin_lastdir = $PluginPath;
1231        $plugin_lastdir =~ s![\\/]$!!;
1232        $plugin_lastdir =~ s!.*[\\/]!!;
1233        local *DH;
1234        if ( opendir DH, $PluginPath ) {
1235            my @p = readdir DH;
1236          PLUGIN:
1237            for my $plugin (@p) {
1238                next if ( $plugin =~ /^\.\.?$/ || $plugin =~ /~$/ );
1239
1240                my $load_plugin = sub {
1241                    my ( $plugin, $sig ) = @_;
1242                    die "Bad plugin filename '$plugin'"
1243                      if ( $plugin !~ /^([-\\\/\@\:\w\.\s~]+)$/ );
1244                    local $plugin_sig      = $sig;
1245                    local $plugin_registry = {};
1246                    $plugin = $1;
1247                    if (
1248                        !$use_plugins
1249                        || ( exists $PluginSwitch->{$plugin_sig}
1250                            && !$PluginSwitch->{$plugin_sig} )
1251                      )
1252                    {
1253                        $Plugins{$plugin_sig}{full_path} = $plugin_full_path;
1254                        $Plugins{$plugin_sig}{enabled}   = 0;
1255                        return 0;
1256                    }
1257                    return 0 if exists $Plugins{$plugin_sig};
1258                    $Plugins{$plugin_sig}{full_path} = $plugin_full_path;
1259                    $timer->pause_partial if $timer;
1260                    eval { require $plugin };
1261                    $timer->mark("Loaded plugin " . $sig) if $timer;
1262                    if ($@) {
1263                        $Plugins{$plugin_sig}{error} = $@;
1264                        # Issue MT log within another eval block in the
1265                        # event that the plugin error is happening before
1266                        # the database has been initialized...
1267                        eval {
1268                            require MT::Log;
1269                            $mt->log(
1270                                {
1271                                    message => $mt->translate(
1272                                        "Plugin error: [_1] [_2]", $plugin,
1273                                        $Plugins{$plugin_sig}{error}
1274                                    ),
1275                                    class => 'system',
1276                                    level => MT::Log::ERROR()
1277                                }
1278                            );
1279                        };
1280                        return 0;
1281                    }
1282                    else {
1283                        if ( my $obj = $Plugins{$plugin_sig}{object} ) {
1284                            $obj->init_callbacks();
1285                        }
1286                        else {
1287
1288                            # A plugin did not register itself, so
1289                            # create a dummy plugin object which will
1290                            # cause it to show up in the plugin listing
1291                            # by it's filename.
1292                            MT->add_plugin( {} );
1293                        }
1294                    }
1295                    $Plugins{$plugin_sig}{enabled} = 1;
1296                    return 1;
1297                };
1298                $plugin_full_path = File::Spec->catfile( $PluginPath, $plugin );
1299                if ( -f $plugin_full_path ) {
1300                    $plugin_envelope = $plugin_lastdir;
1301                    $load_plugin->( $plugin_full_path, $plugin )
1302                      if $plugin_full_path =~ /\.pl$/;
1303                }
1304                else {
1305                    my $plugin_dir = $plugin;
1306                    $plugin_envelope = "$plugin_lastdir/" . $plugin;
1307
1308                    # handle config.yaml
1309                    my $yaml =
1310                      File::Spec->catdir( $plugin_full_path, 'config.yaml' );
1311                    my $libdir;
1312                    ( unshift @INC, $libdir )
1313                      if -d ( $libdir =
1314                          File::Spec->catdir( $plugin_full_path, 'lib' ) );
1315                    if ( -f $yaml ) {
1316                        my $pclass =
1317                          $plugin_dir =~ m/\.pack$/
1318                          ? 'MT::Component'
1319                          : 'MT::Plugin';
1320
1321                        # Don't process disabled plugin config.yaml files.
1322                        if (
1323                            $pclass eq 'MT::Plugin'
1324                            && (
1325                                !$use_plugins
1326                                || ( exists $PluginSwitch->{$plugin_dir}
1327                                    && !$PluginSwitch->{$plugin_dir} )
1328                            )
1329                          )
1330                        {
1331                            $Plugins{$plugin_dir}{full_path} =
1332                              $plugin_full_path;
1333                            $Plugins{$plugin_dir}{enabled} = 0;
1334                            next;
1335                        }
1336                        my $id = lc $plugin_dir;
1337                        $id =~ s/\.\w+$//;
1338                        my $p = $pclass->new(
1339                            {
1340                                id       => $id,
1341                                path     => $plugin_full_path,
1342                                envelope => $plugin_envelope
1343                            }
1344                        );
1345
1346                        # rebless? based on config?
1347                        local $plugin_sig = $plugin_dir;
1348                        MT->add_plugin($p);
1349                        $p->init_callbacks()
1350                            if $pclass eq 'MT::Plugin';
1351                        next;
1352                    }
1353
1354                    opendir SUBDIR, $plugin_full_path;
1355                    my @plugins = readdir SUBDIR;
1356                    closedir SUBDIR;
1357                    for my $plugin (@plugins) {
1358                        next if $plugin !~ /\.pl$/;
1359                        my $plugin_file =
1360                          File::Spec->catfile( $plugin_full_path, $plugin );
1361                        if ( -f $plugin_file ) {
1362                            $load_plugin->(
1363                                $plugin_file, $plugin_dir . '/' . $plugin
1364                            );
1365                        }
1366                    }
1367                }
1368            }
1369            closedir DH;
1370        }
1371    }
1372
1373    # Reset the Text_filters hash in case it was preloaded by plugins by
1374    # calling all_text_filters (Markdown in particular does this).
1375    # Upon calling all_text_filters again, it will be properly loaded by
1376    # querying the registry.
1377    %Text_filters = ();
1378
1379    1;
1380}
1381
1382my %addons;
1383
1384sub find_addons {
1385    my $mt = shift;
1386    my ($type) = @_;
1387
1388    unless (%addons) {
1389        my $addon_path = File::Spec->catdir( $MT_DIR, 'addons' );
1390        local *DH;
1391        if ( opendir DH, $addon_path ) {
1392            my @p = readdir DH;
1393            foreach my $p (@p) {
1394                next if $p eq '.' || $p eq '..';
1395                my $full_path = File::Spec->catdir( $addon_path, $p );
1396                if ( -d $full_path ) {
1397                    if ( $p =~ m/^(.+)\.(\w+)$/ ) {
1398                        my $label = $1;
1399                        my $id    = lc $1;
1400                        my $type  = $2;
1401                        if ( $type eq 'pack' ) {
1402                            $label .= ' Pack';
1403                        }
1404                        elsif ( $type eq 'theme' ) {
1405                            $label .= ' Theme';
1406                        }
1407                        elsif ( $type eq 'plugin' ) {
1408                            $label .= ' Plugin';
1409                        }
1410                        push @{ $addons{$type} },
1411                          {
1412                            label    => $label,
1413                            id       => $id,
1414                            envelope => 'addons/' . $p . '/',
1415                            path     => $full_path,
1416                          };
1417                    }
1418                }
1419            }
1420        }
1421    }
1422    if ($type) {
1423        my $addons = $addons{$type} ||= [];
1424        return $addons;
1425    }
1426    return 1;
1427}
1428
1429*mt_dir = \&server_path;
1430sub server_path { $_[0]->{mt_dir} }
1431sub app_dir     { $_[0]->{app_dir} }
1432sub config_dir  { $_[0]->{config_dir} }
1433
1434sub component {
1435    my $mt = shift;
1436    my ($id) = @_;
1437    return $Components{ lc $id };
1438}
1439
1440sub publisher {
1441    my $mt = shift;
1442    $mt = $mt->instance unless ref $mt;
1443    unless ( $mt->{WeblogPublisher} ) {
1444        require MT::WeblogPublisher;
1445        $mt->{WeblogPublisher} = new MT::WeblogPublisher();
1446    }
1447    $mt->{WeblogPublisher};
1448}
1449
1450sub rebuild {
1451    my $mt = shift;
1452    $mt->publisher->rebuild(@_)
1453      or return $mt->error( $mt->publisher->errstr );
1454}
1455
1456sub rebuild_entry {
1457    my $mt = shift;
1458    $mt->publisher->rebuild_entry(@_)
1459      or return $mt->error( $mt->publisher->errstr );
1460}
1461
1462sub rebuild_indexes {
1463    my $mt = shift;
1464    $mt->publisher->rebuild_indexes(@_)
1465      or return $mt->error( $mt->publisher->errstr );
1466}
1467
1468sub rebuild_archives {
1469    my $mt = shift;
1470    $mt->publisher->rebuild_archives(@_)
1471      or return $mt->error( $mt->publisher->errstr );
1472}
1473
1474sub ping {
1475    my $mt    = shift;
1476    my %param = @_;
1477    my $blog;
1478    require MT::Entry;
1479    require MT::Util;
1480    unless ( $blog = $param{Blog} ) {
1481        my $blog_id = $param{BlogID};
1482        $blog = MT::Blog->load($blog_id)
1483          or return $mt->trans_error( "Load of blog '[_1]' failed: [_2]",
1484            $blog_id, MT::Blog->errstr );
1485    }
1486
1487    my (@res);
1488
1489    my $send_updates = 1;
1490    if ( exists $param{OldStatus} ) {
1491        ## If this is a new entry (!$old_status) OR the status was previously
1492        ## set to draft, and is now set to publish, send the update pings.
1493        my $old_status = $param{OldStatus};
1494        if ( $old_status && $old_status eq MT::Entry::RELEASE() ) {
1495            $send_updates = 0;
1496        }
1497    }
1498
1499    if ( $send_updates && !( MT->config->DisableNotificationPings ) ) {
1500        ## Send update pings.
1501        my @updates = $mt->update_ping_list($blog);
1502        for my $url (@updates) {
1503            require MT::XMLRPC;
1504            if ( MT::XMLRPC->ping_update( 'weblogUpdates.ping', $blog, $url ) )
1505            {
1506                push @res, { good => 1, url => $url, type => "update" };
1507            }
1508            else {
1509                push @res,
1510                  {
1511                    good  => 0,
1512                    url   => $url,
1513                    type  => "update",
1514                    error => MT::XMLRPC->errstr
1515                  };
1516            }
1517        }
1518        if ( $blog->mt_update_key ) {
1519            require MT::XMLRPC;
1520            if ( MT::XMLRPC->mt_ping($blog) ) {
1521                push @res,
1522                  {
1523                    good => 1,
1524                    url  => $mt->{cfg}->MTPingURL,
1525                    type => "update"
1526                  };
1527            }
1528            else {
1529                push @res,
1530                  {
1531                    good  => 0,
1532                    url   => $mt->{cfg}->MTPingURL,
1533                    type  => "update",
1534                    error => MT::XMLRPC->errstr
1535                  };
1536            }
1537        }
1538    }
1539
1540    my $cfg     = $mt->{cfg};
1541    my $send_tb = $cfg->OutboundTrackbackLimit;
1542    return \@res if $send_tb eq 'off';
1543
1544    my @tb_domains;
1545    if ( $send_tb eq 'selected' ) {
1546        @tb_domains = $cfg->OutboundTrackbackDomains;
1547    }
1548    elsif ( $send_tb eq 'local' ) {
1549        my $iter = MT::Blog->load_iter();
1550        while ( my $b = $iter->() ) {
1551            next if $b->id == $blog->id;
1552            push @tb_domains, MT::Util::extract_domains( $b->site_url );
1553        }
1554    }
1555    my $tb_domains;
1556    if (@tb_domains) {
1557        $tb_domains = '';
1558        my %seen;
1559        local $_;
1560        foreach (@tb_domains) {
1561            next unless $_;
1562            $_ = lc($_);
1563            next if $seen{$_};
1564            $tb_domains .= '|' if $tb_domains ne '';
1565            $tb_domains .= quotemeta($_);
1566            $seen{$_} = 1;
1567        }
1568        $tb_domains = '(' . $tb_domains . ')' if $tb_domains;
1569    }
1570
1571    ## Send TrackBack pings.
1572    if ( my $entry = $param{Entry} ) {
1573        my $pings = $entry->to_ping_url_list;
1574
1575        my %pinged = map { $_ => 1 } @{ $entry->pinged_url_list };
1576        my $cats = $entry->categories;
1577        for my $cat (@$cats) {
1578            push @$pings, grep !$pinged{$_}, @{ $cat->ping_url_list };
1579        }
1580
1581        my $ua = MT->new_ua;
1582
1583        ## Build query string to be sent on each ping.
1584        my @qs;
1585        push @qs, 'title=' . MT::Util::encode_url( $entry->title );
1586        push @qs, 'url=' . MT::Util::encode_url( $entry->permalink );
1587        push @qs, 'excerpt=' . MT::Util::encode_url( $entry->get_excerpt );
1588        push @qs, 'blog_name=' . MT::Util::encode_url( $blog->name );
1589        my $qs = join '&', @qs;
1590
1591        ## Character encoding--best guess.
1592        my $enc = $mt->{cfg}->PublishCharset;
1593
1594        for my $url (@$pings) {
1595            $url =~ s/^\s*//;
1596            $url =~ s/\s*$//;
1597            my $url_domain;
1598            ($url_domain) = MT::Util::extract_domains($url);
1599            next if $tb_domains && lc($url_domain) !~ m/$tb_domains$/;
1600
1601            my $req = HTTP::Request->new( POST => $url );
1602            $req->content_type(
1603                "application/x-www-form-urlencoded; charset=$enc");
1604            $req->content($qs);
1605            my $res = $ua->request($req);
1606            if ( substr( $res->code, 0, 1 ) eq '2' ) {
1607                my $c = $res->content;
1608                my ( $error, $msg ) =
1609                  $c =~ m!<error>(\d+).*<message>(.+?)</message>!s;
1610                if ($error) {
1611                    push @res,
1612                      {
1613                        good  => 0,
1614                        url   => $url,
1615                        type  => 'trackback',
1616                        error => $msg
1617                      };
1618                }
1619                else {
1620                    push @res, { good => 1, url => $url, type => 'trackback' };
1621                }
1622            }
1623            else {
1624                push @res,
1625                  {
1626                    good  => 0,
1627                    url   => $url,
1628                    type  => 'trackback',
1629                    error => "HTTP error: " . $res->status_line
1630                  };
1631            }
1632        }
1633    }
1634    \@res;
1635}
1636
1637sub ping_and_save {
1638    my $mt    = shift;
1639    my %param = @_;
1640    if ( my $entry = $param{Entry} ) {
1641        my $results = MT::ping( $mt, @_ ) or return;
1642        my %still_ping;
1643        my $pinged = $entry->pinged_url_list;
1644        for my $res (@$results) {
1645            next if $res->{type} ne 'trackback';
1646            if ( !$res->{good} ) {
1647                $still_ping{ $res->{url} } = 1;
1648            }
1649            push @$pinged,
1650              $res->{url}
1651              . ( $res->{good}
1652                ? ''
1653                : ' ' . MT::I18N::encode_text( $res->{error} ) );
1654        }
1655        $entry->pinged_urls( join "\n", @$pinged );
1656        $entry->to_ping_urls( join "\n", keys %still_ping );
1657        $entry->save or return $mt->error( $entry->errstr );
1658        return $results;
1659    }
1660    1;
1661}
1662
1663sub needs_ping {
1664    my $mt    = shift;
1665    my %param = @_;
1666    my $blog  = $param{Blog};
1667    my $entry = $param{Entry};
1668    require MT::Entry;
1669    return unless $entry->status == MT::Entry::RELEASE();
1670    my $old_status = $param{OldStatus};
1671    my %list;
1672    ## If this is a new entry (!$old_status) OR the status was previously
1673    ## set to draft, and is now set to publish, send the update pings.
1674    if ( ( !$old_status || $old_status ne MT::Entry::RELEASE() )
1675        && !( MT->config->DisableNotificationPings ) )
1676    {
1677        my @updates = $mt->update_ping_list($blog);
1678        @list{@updates} = (1) x @updates;
1679        $list{ $mt->{cfg}->MTPingURL } = 1 if $blog && $blog->mt_update_key;
1680    }
1681    if ($entry) {
1682        @list{ @{ $entry->to_ping_url_list } } = ();
1683        my %pinged = map { $_ => 1 } @{ $entry->pinged_url_list };
1684        my $cats = $entry->categories;
1685        for my $cat (@$cats) {
1686            @list{ grep !$pinged{$_}, @{ $cat->ping_url_list } } = ();
1687        }
1688    }
1689    my @list = keys %list;
1690    return unless @list;
1691    \@list;
1692}
1693
1694sub update_ping_list {
1695    my $mt = shift;
1696    my ($blog) = @_;
1697
1698    my @updates;
1699    if ( my $pings = MT->registry('ping_servers') ) {
1700        my $up = $blog->update_pings;
1701        if ($up) {
1702            foreach ( split ',', $up ) {
1703                next unless exists $pings->{$_};
1704                push @updates, $pings->{$_}->{url};
1705            }
1706        }
1707    }
1708    if ( my $others = $blog->ping_others ) {
1709        push @updates, split /\r?\n/, $others;
1710    }
1711    my %updates;
1712    for my $url (@updates) {
1713        for ($url) {
1714            s/^\s*//;
1715            s/\s*$//;
1716        }
1717        next unless $url =~ /\S/;
1718        $updates{$url}++;
1719    }
1720    keys %updates;
1721}
1722
1723{
1724    my $LH;
1725
1726    sub set_language {
1727        my $pkg = shift;
1728        require MT::L10N;
1729        $LH = MT::L10N->get_handle(@_);
1730
1731        # Clear any l10n_handles in request
1732        $pkg->request( 'l10n_handle', {} );
1733        return $LH;
1734    }
1735
1736    require MT::I18N;
1737
1738    sub translate {
1739        my $this = shift;
1740        my $app = ref($this) ? $this : $this->app;
1741        if ( $app->{component} ) {
1742            if ( my $c = $app->component( $app->{component} ) ) {
1743                local $app->{component} = undef;
1744                return $c->translate(@_);
1745            }
1746        }
1747        my ( $format, @args ) = @_;
1748        foreach (@args) {
1749            $_ = $_->() if ref($_) eq 'CODE';
1750        }
1751        my $enc = MT->instance->config('PublishCharset') || 'utf-8';
1752        return $LH->maketext( $format, @args ) if $enc =~ m/utf-?8/i;
1753        $format = MT::I18N::encode_text( $format, $enc, 'utf-8' );
1754        MT::I18N::encode_text(
1755            $LH->maketext(
1756                $format,
1757                map { MT::I18N::encode_text( $_, $enc, 'utf-8' ) } @args
1758            ),
1759            'utf-8', $enc
1760        );
1761    }
1762
1763    sub translate_templatized {
1764        my $mt = shift;
1765        my $app = ref($mt) ? $mt : $mt->app;
1766        if ( $app->{component} ) {
1767            if ( my $c = $app->component( $app->{component} ) ) {
1768                local $app->{component} = undef;
1769                return $c->translate_templatized(@_);
1770            }
1771        }
1772        my @cstack;
1773        my ($text) = @_;
1774        while (1) {
1775            $text =~ s!(<(/)?(?:_|MT)_TRANS(_SECTION)?(?:(?:\s+((?:\w+)\s*=\s*(["'])(?:(<(?:[^"'>]|"[^"]*"|'[^']*')+)?>|[^\5]+?)*?\5))+?\s*/?)?>)!
1776            my($msg, $close, $section, %args) = ($1, $2, $3);
1777            while ($msg =~ /\b(\w+)\s*=\s*(["'])((?:<(?:[^"'>]|"[^"]*"|'[^']*')+?>|[^\2])*?)?\2/g) {  #"
1778                $args{$1} = $3;
1779            }
1780            if ($section) {
1781                if ($close) {
1782                    $mt = pop @cstack;
1783                } else {
1784                    if ($args{component}) {
1785                        push @cstack, $mt;
1786                        $mt = MT->component($args{component})
1787                            or die "Bad translation component: $args{component}";
1788                    }
1789                    else {
1790                        die "__trans_section without a component argument";
1791                    }
1792                }
1793                '';
1794            }
1795            else {
1796                $args{params} = '' unless defined $args{params};
1797                my @p = map MT::Util::decode_html($_),
1798                        split /\s*%%\s*/, $args{params}, -1;
1799                @p = ('') unless @p;
1800                my $translation = $mt->translate($args{phrase}, @p);
1801                if (exists $args{escape}) {
1802                    if (lc($args{escape}) eq 'html') {
1803                        $translation = MT::Util::encode_html($translation);
1804                    } elsif (lc($args{escape}) eq 'url') {
1805                        $translation = MT::Util::encode_url($translation);
1806                    } else {
1807                        # fallback for js/javascript/singlequotes
1808                        $translation = MT::Util::encode_js($translation);
1809                    }
1810                }
1811                $translation;
1812            }
1813            !igem or last;
1814        }
1815        return $text;
1816    }
1817
1818    sub current_language { $LH->language_tag }
1819    sub language_handle  { $LH }
1820
1821    sub charset {
1822        my $mt = shift;
1823        $mt->{charset} = shift if @_;
1824        return $mt->{charset} if $mt->{charset};
1825        $mt->{charset} = $mt->config->PublishCharset
1826          || $mt->language_handle->encoding;
1827    }
1828}
1829
1830sub supported_languages {
1831    my $mt = shift;
1832    require MT::L10N;
1833    require File::Basename;
1834    ## Determine full path to lib/MT/L10N directory...
1835    my $lib =
1836      File::Spec->catdir( File::Basename::dirname( $INC{'MT/L10N.pm'} ),
1837        'L10N' );
1838    ## ... From that, determine full path to extlib/MT/L10N.
1839    ## To do that, we look for the last instance of the string 'lib'
1840    ## in $lib and replace it with 'extlib'. reverse is a nice tricky
1841    ## way of doing that.
1842    ( my $extlib = reverse $lib ) =~ s!bil!biltxe!;
1843    $extlib = reverse $extlib;
1844    my @dirs = ( $lib, $extlib );
1845    my %langs;
1846    for my $dir (@dirs) {
1847        opendir DH, $dir or next;
1848        for my $f ( readdir DH ) {
1849            my ($tag) = $f =~ /^(\w+)\.pm$/;
1850            next unless $tag;
1851            my $lh = MT::L10N->get_handle($tag);
1852            $langs{ $lh->language_tag } = $lh->language_name;
1853        }
1854        closedir DH;
1855    }
1856    \%langs;
1857}
1858
1859# For your convenience
1860sub trans_error {
1861    my $app = shift;
1862    $app->error( $app->translate(@_) );
1863}
1864
1865sub all_text_filters {
1866    unless (%Text_filters) {
1867        if ( my $filters = MT->registry('text_filters') ) {
1868            %Text_filters = %$filters if ref($filters) eq 'HASH';
1869        }
1870    }
1871    if (my $enabled_filters = MT->config('AllowedTextFilters')) {
1872        my %enabled = map { $_ => 1 } split /\s*,\s*/, $enabled_filters;
1873        %Text_filters = map { $_ => $Text_filters{$_} }
1874                        grep { exists $enabled{$_} }
1875                        keys %Text_filters;
1876    }
1877    return \%Text_filters;
1878}
1879
1880sub apply_text_filters {
1881    my $mt = shift;
1882    my ( $str, $filters, @extra ) = @_;
1883    my $all_filters = $mt->all_text_filters;
1884    for my $filter (@$filters) {
1885        my $f = $all_filters->{$filter} or next;
1886        my $code = $f->{code} || $f->{handler};
1887        unless ( ref($code) eq 'CODE' ) {
1888            $code = $mt->handler_to_coderef($code);
1889            $f->{code} = $code;
1890        }
1891        if ( !$code ) {
1892            warn "Bad text filter: $filter";
1893            next;
1894        }
1895        $str = $code->( $str, @extra );
1896    }
1897    return $str;
1898}
1899
1900sub static_path {
1901    my $app = shift;
1902    my $spath = $app->config->StaticWebPath;
1903    if (!$spath) {
1904        $spath = $app->config->CGIPath;
1905        $spath .= '/' unless $spath =~ m!/$!;
1906        $spath .= 'mt-static/';
1907    } else {
1908        $spath .= '/' unless $spath =~ m!/$!;
1909    }
1910    $spath;
1911}
1912
1913sub static_file_path {
1914    my $app = shift;
1915    return $app->{__static_file_path}
1916        if exists $app->{__static_file_path};
1917
1918    my $path = $app->config('StaticFilePath');
1919    return $app->{__static_file_path} = $path if defined $path;
1920
1921    # Attempt to derive StaticFilePath based on environment
1922    my $web_path = $app->config->StaticWebPath || 'mt-static';
1923    $web_path =~ s!^https?://[^/]+/!!;
1924    if ($app->can('document_root')) {
1925        my $doc_static_path = File::Spec->catdir($app->document_root(), $web_path);
1926        return $app->{__static_file_path} = $doc_static_path
1927            if -d $doc_static_path;
1928    }
1929    my $mtdir_static_path = File::Spec->catdir($app->mt_dir, 'mt-static');
1930    return $app->{__static_file_path} = $mtdir_static_path
1931        if -d $mtdir_static_path;
1932    return;
1933}
1934
1935sub template_paths {
1936    my $mt = shift;
1937    my @paths;
1938    my $path = $mt->config->TemplatePath;
1939    if ($mt->{plugin_template_path}) {
1940        if (File::Spec->file_name_is_absolute($mt->{plugin_template_path})) {
1941            push @paths, $mt->{plugin_template_path}
1942                if -d $mt->{plugin_template_path};
1943        } else {
1944            my $dir = File::Spec->catdir($mt->app_dir,
1945                                         $mt->{plugin_template_path});
1946            if (-d $dir) {
1947                push @paths, $dir;
1948            } else {
1949                $dir = File::Spec->catdir($mt->mt_dir,
1950                                          $mt->{plugin_template_path});
1951                push @paths, $dir if -d $dir;
1952            }
1953        }
1954    }
1955    if (my $alt_path = $mt->config->AltTemplatePath) {
1956        if (-d $alt_path) {    # AltTemplatePath is absolute
1957            push @paths, File::Spec->catdir($alt_path,
1958                                            $mt->{template_dir})
1959                if $mt->{template_dir};
1960            push @paths, $alt_path;
1961        }
1962    }
1963 
1964    for my $addon ( @{ $mt->find_addons('pack') } ) {
1965        push @paths, File::Spec->catdir($addon->{path}, 'tmpl', $mt->{template_dir})
1966            if $mt->{template_dir};
1967        push @paths, File::Spec->catdir($addon->{path}, 'tmpl');
1968    }
1969
1970    push @paths, File::Spec->catdir($path, $mt->{template_dir})
1971        if $mt->{template_dir};
1972    push @paths, $path;
1973 
1974    return @paths;
1975}
1976
1977sub find_file {
1978    my $mt = shift;
1979    my ($paths, $file) = @_;
1980    my $filename;
1981    foreach my $p (@$paths) {
1982        my $filepath = File::Spec->canonpath(File::Spec->catfile($p, $file));
1983        $filename = File::Spec->canonpath($filepath);
1984        return $filename if -f $filename;
1985    }
1986    undef;
1987}
1988
1989sub load_tmpl {
1990    my $mt = shift;
1991    if ($mt->{component}) {
1992        if (my $c = $mt->component($mt->{component})) {
1993            return $c->load_tmpl(@_);
1994        }
1995    }
1996
1997    my($file, @p) = @_;
1998    my $param;
1999    if (@p && (ref($p[$#p]) eq 'HASH')) {
2000        $param = pop @p;
2001    }
2002    my $cfg = $mt->config;
2003    require MT::Template;
2004    my $tmpl;
2005    my @paths = $mt->template_paths;
2006
2007    my $type = {'SCALAR' => 'scalarref', 'ARRAY' => 'arrayref'}->{ref $file}
2008        || 'filename';
2009    $tmpl = MT::Template->new(
2010        type => $type, source => $file,
2011        path => \@paths,
2012        filter => sub {
2013            my ($str, $fname) = @_;
2014            if ($fname) {
2015                $fname = File::Basename::basename($fname);
2016                $fname =~ s/\.tmpl$//;
2017                $mt->run_callbacks("template_source.$fname", $mt, @_);
2018            } else {
2019                $mt->run_callbacks("template_source", $mt, @_);
2020            }
2021            return $str;
2022        },
2023        @p);
2024    return $mt->error(
2025        $mt->translate("Loading template '[_1]' failed.", $file)) unless $tmpl;
2026    $mt->set_default_tmpl_params($tmpl);
2027    $tmpl->param($param) if $param;
2028    $tmpl;
2029}
2030
2031sub set_default_tmpl_params {
2032    my $mt = shift;
2033    my ($tmpl) = @_;
2034    my $param = {};
2035    $param->{mt_debug} = $MT::DebugMode;
2036    $param->{mt_beta} = 1 if MT->version_id =~ m/^\d+\.\d+(?:a|b|rc)/;
2037    $param->{static_uri} = $mt->static_path;
2038    $param->{mt_version} = MT->version_number;
2039    $param->{mt_version_id} = MT->version_id;
2040    $param->{mt_product_code} = MT->product_code;
2041    $param->{mt_product_name} = $mt->translate(MT->product_name);
2042    $param->{language_tag} = substr($mt->current_language, 0, 2);
2043    $param->{language_encoding} = $mt->charset;
2044    if ($mt->isa('MT::App')) {
2045        if (my $author = $mt->user) {
2046            $param->{author_id} = $author->id;
2047            $param->{author_name} = $author->name;
2048        }
2049        ## We do this in load_tmpl because show_error and login don't call
2050        ## build_page; so we need to set these variables here.
2051        require MT::Auth;
2052        $param->{can_logout} = MT::Auth->can_logout;
2053        $param->{script_url} = $mt->uri;
2054        $param->{mt_url} = $mt->mt_uri;
2055        $param->{script_path} = $mt->path;
2056        $param->{script_full_url} = $mt->base . $mt->uri;
2057        $param->{agent_mozilla} = ( $ENV{HTTP_USER_AGENT} || '' ) =~ /gecko/i;
2058        $param->{agent_ie} = ( $ENV{HTTP_USER_AGENT} || '' ) =~ /\bMSIE\b/;
2059    }
2060    if (!$tmpl->param('template_filename')) {
2061        if (my $fname = $tmpl->{__file}) {
2062            $fname =~ s!\\!/!g;
2063            $fname =~ s/\.tmpl$//;
2064            $param->{template_filename} = $fname;
2065        }
2066    }
2067    $tmpl->param($param);
2068}
2069
2070sub process_mt_template {
2071    my $mt = shift;
2072    my ($body) = @_;
2073    $body =~ s@<(?:_|MT)_ACTION\s+mode="([^"]+)"(?:\s+([^>]*))?>@
2074        my $mode = $1; my %args;
2075        %args = $2 =~ m/\s*(\w+)="([^"]*?)"\s*/g if defined $2; # "
2076        MT::Util::encode_html($mt->uri(mode => $mode, args => \%args));
2077    @geis;
2078    # Strip out placeholder wrappers to facilitate tmpl_* callbacks
2079    $body =~ s/<\/?MT_(\w+):(\w+)>//g;
2080    $body;
2081}
2082
2083sub build_page {
2084    my $mt = shift;
2085    my($file, $param) = @_;
2086    my $tmpl;
2087    my $mode = $mt->mode;
2088    $param->{"mode_$mode"} ||= 1;
2089    $param->{breadcrumbs} = $mt->{breadcrumbs};
2090    if ($param->{breadcrumbs}[-1]) {
2091        $param->{breadcrumbs}[-1]{is_last} = 1;
2092        $param->{page_titles} = [ reverse @{ $mt->{breadcrumbs} } ];
2093    }
2094    pop @{ $param->{page_titles} };
2095    if (my $lang_id = $mt->current_language) {
2096        $param->{local_lang_id} ||= lc $lang_id;
2097    }
2098    $param->{magic_token} = $mt->current_magic if $mt->user;
2099
2100    # List of installed packs in the application footer
2101    my @packs_installed;
2102    my $packs = $mt->find_addons('pack');
2103    if ($packs) {
2104        foreach my $pack (@$packs) {
2105            my $c = $mt->component(lc $pack->{id});
2106            if ($c) {
2107                my $label = $c->label || $pack->{label};
2108                $label = $label->() if ref($label) eq 'CODE';
2109                push @packs_installed, {
2110                    label => $label,
2111                    version => $c->version,
2112                    id => $c->id,
2113                };
2114            }
2115        }
2116    }
2117    @packs_installed = sort { $a->{label} cmp $b->{label} } @packs_installed;
2118    $param->{packs_installed} = \@packs_installed;
2119    $param->{portal_url} = $mt->translate("__PORTAL_URL__");
2120
2121    for my $config_field (keys %{ MT::ConfigMgr->instance->{__var} || {} }) {
2122        $param->{ $config_field . '_readonly' } = 1;
2123    }
2124
2125    my $tmpl_file = '';
2126    if (UNIVERSAL::isa($file, 'MT::Template')) {
2127        $tmpl = $file;
2128        $tmpl_file = (exists $file->{__file}) ? $file->{__file} : '';
2129    } else {
2130        $tmpl = $mt->load_tmpl($file) or return;
2131        $tmpl_file = $file unless ref($file);
2132    }
2133
2134    if (($mode && ($mode !~ m/delete/)) && ($mt->{login_again} ||
2135        ($mt->{requires_login} && !$mt->user))) {
2136        ## If it's a login screen, direct the user to where they were going
2137        ## (query params including mode and all) unless they were logging in,
2138        ## logging out, or deleting something.
2139        my $q = $mt->{query};
2140        if ($mode) {
2141            my @query = map { { name => $_, value => scalar encode_text( $q->param($_) ) }; }
2142                grep { ($_ ne 'username') && ($_ ne 'password') && ($_ ne 'submit') && ($mode eq 'logout' ? ($_ ne '__mode') : 1) } $q->param;
2143            $param->{query_params} = \@query;
2144        }
2145        $param->{login_again} = $mt->{login_again};
2146    }
2147
2148    my $blog = $mt->blog;
2149    $tmpl->context()->stash('blog', $blog) if $blog;
2150
2151    $tmpl->param($param) if $param;
2152
2153    if ($tmpl_file) {
2154        $tmpl_file = File::Basename::basename($tmpl_file);
2155        $tmpl_file =~ s/\.tmpl$//;
2156        $tmpl_file = '.' . $tmpl_file;
2157    }
2158    $mt->run_callbacks('template_param' . $tmpl_file, $mt, $tmpl->param, $tmpl);
2159
2160    my $output = $mt->build_page_in_mem($tmpl);
2161    return unless defined $output;
2162
2163    $mt->run_callbacks('template_output' . $tmpl_file, $mt, \$output, $tmpl->param, $tmpl);
2164    return $output;
2165}
2166
2167sub build_page_in_mem {
2168    my $mt = shift;
2169    my($tmpl, $param) = @_;
2170    $tmpl->param($param) if $param;
2171    my $out = $tmpl->output;
2172    return $mt->error($tmpl->errstr) unless defined $out;
2173    return $mt->translate_templatized($mt->process_mt_template($out));
2174}
2175
2176sub new_ua {
2177    my $class = shift;
2178    my ($opt) = @_;
2179    $opt ||= {};
2180    my $lwp_class = 'LWP::UserAgent';
2181    if ($opt->{paranoid}) {
2182        eval { require LWPx::ParanoidAgent; };
2183        $lwp_class = 'LWPx::ParanoidAgent' unless $@;
2184    }
2185    eval "require $lwp_class;";
2186    return undef if $@;
2187    my $cfg = $class->config;
2188    my $max_size = exists $opt->{max_size} ? $opt->{max_size} : 100_000;
2189    my $timeout = exists $opt->{timeout} ? $opt->{timeout} : $cfg->HTTPTimeout || $cfg->PingTimeout;
2190    my $proxy = exists $opt->{proxy} ? $opt->{proxy} : $cfg->HTTPProxy || $cfg->PingProxy;
2191    my $no_proxy = exists $opt->{no_proxy} ? $opt->{no_proxy} : $cfg->HTTPNoProxy || $cfg->PingNoProxy;
2192    my $agent = $opt->{agent} || 'MovableType/' . $MT::VERSION;
2193    my $interface = exists $opt->{interface} ? $opt->{interface} : $cfg->HTTPInterface || $cfg->PingInterface;
2194
2195    if ( my $localaddr = $interface ) {
2196        @LWP::Protocol::http::EXTRA_SOCK_OPTS = (
2197            LocalAddr => $localaddr,
2198            Reuse     => 1
2199        );
2200    }
2201
2202    my $ua = $lwp_class->new;
2203    $ua->max_size($max_size) if (defined $max_size) && $ua->can('max_size');
2204    $ua->agent( $agent );
2205    $ua->timeout( $timeout ) if defined $timeout;
2206    if ( defined $proxy ) {
2207        $ua->proxy( http => $proxy );
2208        my @domains = split( /,\s*/, $no_proxy ) if $no_proxy;
2209        $ua->no_proxy(@domains) if @domains;
2210    }
2211    return $ua;
2212}
2213
2214sub build_email {
2215    my $class = shift;
2216    my ( $file, $param ) = @_;
2217    my $mt = $class->instance;
2218
2219    # basically, try to load from database
2220    my $blog = $param->{blog} || undef;
2221    my $id = $file;
2222    $id =~ s/(\.tmpl|\.mtml)$//;
2223
2224    require MT::Template;
2225    my @tmpl = MT::Template->load(
2226        {
2227            ( $blog ? ( blog_id => [ $blog->id, 0 ] ) : ( blog_id => 0 ) ),
2228            identifier => $id,
2229            type       => 'email',
2230        }
2231    );
2232    my $tmpl =
2233      @tmpl
2234      ? (
2235        scalar @tmpl > 1
2236        ? ( $tmpl[0]->blog_id ? $tmpl[0] : $tmpl[1] )
2237        : $tmpl[0]
2238      )
2239      : undef;
2240
2241    # try to load from file
2242    unless ($tmpl) {
2243        local $mt->{template_dir} = 'email';
2244        $tmpl = $mt->load_tmpl($file);
2245    }
2246    return unless $tmpl;
2247
2248    my $ctx = $tmpl->context;
2249    $ctx->stash( 'blog',   delete $param->{'blog'} )   if $param->{'blog'};
2250    $ctx->stash( 'entry',  delete $param->{'entry'} )  if $param->{'entry'};
2251    $ctx->stash( 'author', delete $param->{'author'} ) if $param->{'author'};
2252    $ctx->stash( 'commenter', delete $param->{'commenter'} )
2253      if $param->{'commenter'};
2254    $ctx->stash( 'comment', delete $param->{'comment'} ) if $param->{'comment'};
2255    $ctx->stash( 'category', delete $param->{'category'} )
2256      if $param->{'category'};
2257    $ctx->stash( 'ping', delete $param->{'ping'} ) if $param->{'ping'};
2258
2259    foreach my $p (%$param) {
2260        if ( ref($p) ) {
2261            $tmpl->param( $p, $param->{$p} );
2262        }
2263    }
2264    return $mt->build_page_in_mem( $tmpl, $param );
2265}
2266
2267sub get_next_sched_post_for_user {
2268    my ( $author_id, @further_blog_ids ) = @_;
2269    require MT::Permission;
2270    my @perms = MT::Permission->load( { author_id => $author_id }, {} );
2271    my @blogs = @further_blog_ids;
2272    for my $perm (@perms) {
2273        next
2274          unless ( $perm->can_edit_config
2275            || $perm->can_publish_post
2276            || $perm->can_edit_all_posts );
2277        push @blogs, $perm->blog_id;
2278    }
2279    my $next_sched_utc = undef;
2280    require MT::Entry;
2281    for my $blog_id (@blogs) {
2282        my $blog           = MT::Blog->load($blog_id)
2283            or next;
2284        my $earliest_entry = MT::Entry->load(
2285            {
2286                status  => MT::Entry::FUTURE(),
2287                blog_id => $blog_id
2288            },
2289            { 'sort' => 'created_on' }
2290        );
2291        if ($earliest_entry) {
2292            my $entry_utc =
2293              MT::Util::ts2iso( $blog, $earliest_entry->created_on );
2294            if ( $entry_utc < $next_sched_utc || !defined($next_sched_utc) ) {
2295                $next_sched_utc = $entry_utc;
2296            }
2297        }
2298    }
2299    return $next_sched_utc;
2300}
2301
2302our %Commenter_Auth;
2303
2304sub init_commenter_authenticators {
2305    my $self = shift;
2306    my $auths = $self->registry("commenter_authenticators") || {};
2307    foreach my $auth ( keys %$auths ) {
2308        delete $auths->{$auth}
2309          if exists( $auths->{$auth}->{condition} )
2310          && !( $auths->{$auth}->{condition}->() );
2311    }
2312    %Commenter_Auth = %$auths;
2313    $Commenter_Auth{$_}{key} ||= $_ for keys %Commenter_Auth;
2314}
2315
2316sub commenter_authenticator {
2317    my $self = shift;
2318    my ($key) = @_;
2319    %Commenter_Auth or $self->init_commenter_authenticators();
2320    return $Commenter_Auth{$key};
2321}
2322
2323sub commenter_authenticators {
2324    my $self = shift;
2325    %Commenter_Auth or $self->init_commenter_authenticators();
2326    return values %Commenter_Auth;
2327}
2328
2329sub _commenter_auth_params {
2330    my ( $key, $blog_id, $entry_id, $static ) = @_;
2331    my $params = {
2332        blog_id => $blog_id,
2333        static  => $static,
2334    };
2335    $params->{entry_id} = $entry_id if defined $entry_id;
2336    return $params;
2337}
2338
2339sub _openid_commenter_condition {
2340    eval "require Digest::SHA1;";
2341    return $@ ? 0 : 1;
2342}
2343
2344sub core_commenter_authenticators {
2345    return {
2346        'OpenID' => {
2347            class      => 'MT::Auth::OpenID',
2348            label      => 'OpenID',
2349            login_form => <<OpenID,
2350<form method="post" action="<mt:var name="script_url">">
2351<input type="hidden" name="__mode" value="login_external" />
2352<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2353<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2354<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2355<fieldset>
2356<mtapp:setting
2357    id="openid_display"
2358    label="<__trans phrase="OpenID URL">"
2359    hint="<__trans phrase="Sign in using your OpenID identity.">">
2360<input type="hidden" name="key" value="OpenID" />
2361<input name="openid_url" style="background: #fff url('<mt:var name="static_uri">images/comment/openid_logo.png') no-repeat left; padding-left: 18px; padding-bottom: 1px; border: 1px solid #5694b6; width: 304px; font-size: 110%;" />
2362    <p class="hint"><__trans phrase="OpenID is an open and decentralized single sign-on identity system."></p>
2363</mtapp:setting>
2364
2365<div class="pkg">
2366<div class="left"><input type="submit" name="submit" value="<__trans phrase="Sign In">" /></div>
2367<div class="right"><img src="<mt:var name="static_uri">images/comment/openid_enabled.png" /></div>
2368</div>
2369<p><img src="<mt:var name="static_uri">images/comment/blue_moreinfo.png"> <a href="http://www.openid.net/"><__trans phrase="Learn more about OpenID."></a></p>
2370</fieldset>
2371</form>
2372OpenID
2373            login_form_params => \&_commenter_auth_params,
2374            condition         => \&_openid_commenter_condition,
2375            logo              => 'images/comment/signin_openid.png',
2376            logo_small        => 'images/comment/openid_logo.png',
2377        },
2378        'LiveJournal' => {
2379            class      => 'MT::Auth::LiveJournal',
2380            label      => 'LiveJournal',
2381            login_form => <<LiveJournal,
2382<form method="post" action="<mt:var name="script_url">">
2383<input type="hidden" name="__mode" value="login_external" />
2384<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2385<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2386<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2387<input type="hidden" name="key" value="LiveJournal" />
2388<fieldset>
2389<mtapp:setting
2390    id="livejournal_display"
2391    label="<__trans phrase="Your LiveJournal Username">"
2392    hint="<__trans phrase="Sign in using your Vox blog URL">">
2393<input name="openid_userid" style="background: #fff url('<mt:var name="static_uri">images/comment/livejournal_logo.png') no-repeat 2px center; padding: 2px 2px 2px 20px; border: 1px solid #5694b6; width: 300px; font-size: 110%;" />
2394</mtapp:setting>
2395<div class="actions-bar actions-bar-login">
2396    <div class="actions-bar-inner pkg actions">
2397        <button
2398            type="submit"
2399            class="primary-button"
2400            ><__trans phrase="Sign in"></button>
2401    </div>
2402</div>
2403<p><img src="<mt:var name="static_uri">images/comment/blue_moreinfo.png"> <a href="http://www.livejournal.com/"><__trans phrase="Learn more about LiveJournal."></a></p>
2404</fieldset>
2405</form>
2406LiveJournal
2407            login_form_params => \&_commenter_auth_params,
2408            condition         => \&_openid_commenter_condition,
2409            logo              => 'images/comment/signin_livejournal.png',
2410            logo_small        => 'images/comment/livejournal_logo.png',
2411        },
2412        'Vox' => {
2413            class      => 'MT::Auth::Vox',
2414            label      => 'Vox',
2415            login_form => <<Vox,
2416<form method="post" action="<mt:var name="script_url">">
2417<input type="hidden" name="__mode" value="login_external" />
2418<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2419<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2420<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2421<input type="hidden" name="key" value="Vox" />
2422<fieldset>
2423<mtapp:setting
2424    id="vox_display"
2425    label="<__trans phrase="Your Vox Blog URL">">
2426http:// <input name="openid_userid" style="background: #fff url('<mt:var name="static_uri">images/comment/vox_logo.png') no-repeat 2px center; padding: 2px 2px 2px 20px; border: 1px solid #5694b6; width: 200px; font-size: 110%; vertical-align: middle" />.vox.com
2427</mtapp:setting>
2428<div class="actions-bar actions-bar-login">
2429    <div class="actions-bar-inner pkg actions">
2430        <button
2431            type="submit"
2432            class="primary-button"
2433            ><__trans phrase="Sign in"></button>
2434    </div>
2435</div>
2436<p><img src="<mt:var name="static_uri">images/comment/blue_moreinfo.png"> <a href="http://www.vox.com/"><__trans phrase="Learn more about Vox."></a></p>
2437</fieldset>
2438</form>
2439Vox
2440            login_form_params => \&_commenter_auth_params,
2441            condition         => \&_openid_commenter_condition,
2442            logo              => 'images/comment/signin_vox.png',
2443            logo_small        => 'images/comment/vox_logo.png',
2444        },
2445        'TypeKey' => {
2446            class      => 'MT::Auth::TypeKey',
2447            label      => 'TypeKey',
2448            login_form => <<TypeKey,
2449<p class="hint"><__trans phrase="TypeKey is a free, open system providing you a central identity for posting comments on weblogs and logging into other websites. You can register for free."></p>
2450<p><img src="<mt:var name="static_uri">images/comment/blue_goto.png"> <a href="<mt:var name="tk_signin_url">"><__trans phrase="Sign in or register with TypeKey."></a></p>
2451TypeKey
2452            login_form_params => sub {
2453                my ( $key, $blog_id, $entry_id, $static ) = @_;
2454                my $entry = MT::Entry->load($entry_id) if $entry_id;
2455
2456                ## TypeKey URL
2457                require MT::Template::Context;
2458                my $ctx = MT::Template::Context->new;
2459                $ctx->stash( 'blog_id', $blog_id );
2460                my $blog = MT::Blog->load($blog_id);
2461                $ctx->stash( 'blog',  $blog );
2462                $ctx->stash( 'entry', $entry );
2463                my $params = {};
2464                $params->{tk_signin_url} =
2465                  MT::Template::Context::_hdlr_remote_sign_in_link( $ctx,
2466                    { static => $static } );
2467                return $params;
2468            },
2469            logo => 'images/comment/signin_typekey.png',
2470            logo_small        => 'images/comment/typekey_logo.png',
2471        },
2472    };
2473}
2474
2475our %Captcha_Providers;
2476
2477sub captcha_provider {
2478    my $self = shift;
2479    my ($key) = @_;
2480    $self->init_captcha_providers() unless %Captcha_Providers;
2481    return $Captcha_Providers{$key};
2482}
2483
2484sub captcha_providers {
2485    my $self = shift;
2486    $self->init_captcha_providers() unless %Captcha_Providers;
2487    my $def  = delete $Captcha_Providers{'mt_default'};
2488    my @vals = values %Captcha_Providers;
2489    if ( defined($def) && $def->{condition}->() ) {
2490        unshift @vals, $def;
2491    }
2492    @vals;
2493}
2494
2495sub core_captcha_providers {
2496    return {
2497        'mt_default' => {
2498            label     => 'Movable Type default',
2499            class     => 'MT::Util::Captcha',
2500            condition => sub {
2501                require MT::Util::Captcha;
2502                if ( my $error = MT::Util::Captcha->check_availability ) {
2503                    return 0;
2504                }
2505                1;
2506            },
2507        }
2508    };
2509}
2510
2511sub init_captcha_providers {
2512    my $self = shift;
2513    my $providers = $self->registry("captcha_providers") || {};
2514    foreach my $provider ( keys %$providers ) {
2515        delete $providers->{$provider}
2516          if exists( $providers->{$provider}->{condition} )
2517          && !( $providers->{$provider}->{condition}->() );
2518    }
2519    %Captcha_Providers = %$providers;
2520    $Captcha_Providers{$_}{key} ||= $_ for keys %Captcha_Providers;
2521}
2522
2523sub effective_captcha_provider {
2524    my $class = shift;
2525    my ($key) = @_;
2526    return undef unless $key;
2527    my $cp = $class->captcha_provider($key) or return;
2528    if ( exists $cp->{condition} ) {
2529        return undef unless $cp->{condition}->();
2530    }
2531    my $pkg = $cp->{class};
2532    $pkg =~ s/;//g;
2533    eval "require $pkg" or return;
2534    return $cp->{class};
2535}
2536
2537sub handler_to_coderef {
2538    my $pkg = shift;
2539    my ( $name, $delayed ) = @_;
2540
2541    return $name if ref($name) eq 'CODE';
2542    return undef unless defined $name && $name ne '';
2543
2544    my $code;
2545    if ( $name !~ m/->/ ) {
2546
2547        # check for Package::Routine first; if defined, return coderef
2548        no strict 'refs';
2549        $code = \&$name if defined &$name;
2550        return $code if $code;
2551    }
2552
2553    my $component;
2554    if ( $name =~ m!^\$! ) {
2555        if ( $name =~ s/^\$(\w+)::// ) {
2556            $component = $1;
2557        }
2558    }
2559    if ( $name =~ m/^\s*sub\s*\{/s ) {
2560        $code = eval $name or die $@;
2561
2562        if ($component) {
2563            return sub {
2564                my $mt_inst = MT->instance;
2565                local $mt_inst->{component} = $component;
2566                $code->(@_);
2567            };
2568        }
2569        else {
2570            return $code;
2571        }
2572    }
2573
2574    my $hdlr_pkg = $name;
2575    my $method;
2576    if ( $hdlr_pkg =~ s/(->|::)([^:]+)$// ) {    # strip routine name
2577        $method = $2 if $1 eq '->';
2578    }
2579    if ( !defined(&$name) && !$pkg->can( 'AUTOLOAD' ) ) {
2580
2581        # The delayed option will return a coderef that delays the loading
2582        # of the package holding the handler routine.
2583        if ($delayed) {
2584            if ($method) {
2585                return sub {
2586                    eval "require $hdlr_pkg;"
2587                      or Carp::confess(
2588                        "failed loading package $hdlr_pkg for routine $name: $@");
2589                    my $mt_inst = MT->instance;
2590                    local $mt_inst->{component} = $component
2591                      if $component;
2592                    return $hdlr_pkg->$method(@_);
2593                };
2594            }
2595            else {
2596                return sub {
2597                    eval "require $hdlr_pkg;"
2598                      or Carp::confess(
2599                        "failed loading package $hdlr_pkg for routine $name: $@");
2600                    my $mt_inst = MT->instance;
2601                    local $mt_inst->{component} = $component
2602                      if $component;
2603                    no strict 'refs';
2604                    my $hdlr = \&$name;
2605                    use strict 'refs';
2606                    return $hdlr->(@_);
2607                };
2608            }
2609        }
2610        else {
2611            eval "require $hdlr_pkg;"
2612              or Carp::confess(
2613                "failed loading package $hdlr_pkg for routine $name: $@");
2614        }
2615    }
2616    if ($method) {
2617        $code = sub {
2618            my $mt_inst = MT->instance;
2619            local $mt_inst->{component} = $component
2620              if $component;
2621            return $hdlr_pkg->$method(@_);
2622        };
2623    }
2624    else {
2625        if ($component) {
2626            $code = sub {
2627                no strict 'refs';
2628                my $hdlr = (
2629                    defined &$name ? \&$name
2630                    : ( $pkg->can( 'AUTOLOAD' ) ? \&$name
2631                        : undef )
2632                );
2633                use strict 'refs';
2634                if ($hdlr) {
2635                    my $mt_inst = MT->instance;
2636                    local $mt_inst->{component} = $component
2637                      if $component;
2638                    return $hdlr->(@_);
2639                }
2640                return undef;
2641              }
2642        }
2643        else {
2644            no strict 'refs';
2645            $code =
2646              (
2647                defined &$name
2648                ? \&$name
2649                : ( $hdlr_pkg->can( 'AUTOLOAD' ) ? \&$name : undef )
2650              );
2651        }
2652    }
2653    return $code;
2654}
2655
2656sub help_url {
2657    my $pkg = shift;
2658    my ( $append ) = @_;
2659
2660    my $url = $pkg->config->HelpURL;
2661    return $url if defined $url;
2662    $url = $pkg->translate('http://www.movabletype.org/documentation/');
2663    if ( $append ) {
2664        $url .= $append;
2665    }
2666    $url;
2667}
2668
2669sub register_refresh_cache_event {
2670    my $pkg = shift;
2671    my ($callback) = @_;
2672    return unless $callback;
2673
2674    MT->_register_core_callbacks({
2675        "$callback" => \&refresh_cache,
2676    });
2677}
2678
2679sub refresh_cache {
2680    my ($cb, %args) = @_;
2681
2682    require MT::Cache::Negotiate;
2683    my $cache_driver = MT::Cache::Negotiate->new();
2684    return unless $cache_driver;
2685
2686    $cache_driver->flush_all();
2687}
2688
2689sub DESTROY {
2690    # save_config here so not to miss any dirty config change to persist
2691    # particulary for those which does not construct MT::App.
2692    $_[0]->config->save_config();
2693}
2694
26951;
2696
2697__END__
2698
2699=head1 NAME
2700
2701MT - Movable Type
2702
2703=head1 SYNOPSIS
2704
2705    use MT;
2706    my $mt = MT->new;
2707    $mt->rebuild(BlogID => 1)
2708        or die $mt->errstr;
2709
2710=head1 DESCRIPTION
2711
2712The I<MT> class is the main high-level rebuilding/pinging interface in the
2713Movable Type library. It handles all rebuilding operations. It does B<not>
2714handle any of the application functionality--for that, look to I<MT::App> and
2715I<MT::App::CMS>, both of which subclass I<MT> to handle application requests.
2716
2717=head1 PLUGIN APPLICATIONS
2718
2719At any given time, the user of the Movable Type platform is
2720interacting with either the core Movable Type application, or a plugin
2721application (or "sub-application").
2722
2723A plugin application is a plugin with a user interface that inherits
2724functionality from Movable Type, and appears to the user as a
2725component of Movable Type. A plugin application typically has its own
2726templates displaying its own special features; but it inherits some
2727templates from Movable Type, such as the navigation chrome and error
2728pages.
2729
2730=head2 The MT Root and the Application Root
2731
2732To locate assets of the core Movable Type application and any plugin
2733applications, the platform uses two directory paths, C<mt_dir> and
2734C<app_dir>. These paths are returned by the MT class methods with the
2735same names, and some other methods return derivatives of these paths.
2736
2737Conceptually, mt_dir is the root of the Movable Type installation, and
2738app_dir is the root of the "currently running application", which
2739might be Movable Type or a plugin application. It is important to
2740understand the distinction between these two values and what each is
2741used for.
2742
2743The I<mt_dir> is the absolute path to the directory where MT itself is
2744located. Most importantly, the MT configuration file and the CGI scripts that
2745bootstrap an MT request are found here. This directory is also the
2746default base path under which MT's core templates are found (but this
2747can be overridden using the I<TemplatePath> configuration setting).
2748
2749Likewise, the I<app_dir> is the directory where the "current"
2750application's assets are rooted. The platform will search for
2751application templates underneath the I<app_dir>, but this search also
2752searches underneath the I<mt_dir>, allowing the application to make
2753use of core headers, footers, error pages, and possibly other
2754templates.
2755
2756In order for this to be useful, the plugin's templates and
2757code should all be located underneath the same directory. The relative
2758path from the I<app_dir> to the application's templates is
2759configurable. For details on how to indicate the location of your
2760plugin's templates, see L<MT::App>.
2761
2762=head2 Finding the Root Paths
2763
2764When a plugin application initializes its own application class (a
2765subclass of MT::App), the I<mt_dir> should be discovered and passed
2766constructor. This comes either from the C<Directory> parameter or the
2767C<Config> parameter.
2768
2769Since plugins are loaded from a descendent of the MT root directory,
2770the plugin bootstrap code can discover the MT configuration file (and thus
2771the MT root directory) by traversing the filesystem; the absolute path
2772to that file can be passed as the C<Config> parameter to
2773MT::App::new. Working code to do this can be found in the
2774examples/plugins/mirror/mt-mirror.cgi file.
2775
2776The I<app_dir>, on the other hand, always derives from the location of
2777the currently-running program, so it typically does not need to be
2778specified.
2779
2780=head1 USAGE
2781
2782I<MT> has the following interface. On failure, all methods return C<undef>
2783and set the I<errstr> for the object or class (depending on whether the
2784method is an object or class method, respectively); look below at the section
2785L<ERROR HANDLING> for more information.
2786
2787=head2 MT->new( %args )
2788
2789Constructs a new I<MT> instance and returns that object. Returns C<undef>
2790on failure.
2791
2792I<new> will also read your MT configuration file (provided that it can find it--if
2793you find that it can't, take a look at the I<Config> directive, below). It
2794will also initialize the chosen object driver; the default is the C<DBM>
2795object driver.
2796
2797I<%args> can contain:
2798
2799=over 4
2800
2801=item * Config
2802
2803Path to the MT configuration file.
2804
2805If you do not specify a path, I<MT> will try to find your MT configuration file
2806in the current working directory.
2807
2808=item * Directory
2809
2810Path to the MT home directory.
2811
2812If you do not specify a path, I<MT> will try to find the MT directory using
2813the discovered path of the MT configuration file.
2814
2815=back
2816
2817=head2 $mt->init
2818
2819Initializes the Movable Type instance, including registration of basic
2820resources and callbacks. This method also invokes the C<init_config>
2821and C<init_plugins> methods.
2822
2823=head2 MT->instance
2824
2825MT and all it's subclasses are now singleton classes, meaning you can only
2826have one instance per package. MT->instance() returns the active instance.
2827MT->new() is now an alias to instance_of.
2828
2829=head2 $class->instance_of
2830
2831Returns the singleton instance of the MT subclass identified by C<$class>.
2832
2833=head2 $class->construct
2834
2835Constructs a new instance of the MT subclass identified by C<$class>.
2836
2837=head2 MT->set_instance
2838
2839Assigns the active MT instance object. This value is returned when
2840C<MT-E<gt>instance> is invoked.
2841
2842=head2 $mt->find_config($params)
2843
2844Handles the discovery of the MT configuration file. The path and filename
2845for the configuration file is returned as the result. The C<$params>
2846parameter is a reference to the hash of settings passed to the MT
2847constructor.
2848
2849=head2 $mt->init_config($params)
2850
2851Reads the MT configuration settingss from the MT configuration file
2852and settings from database (L<MT::Config>).
2853
2854The C<$params> parameter is a reference to the hash of settings passed to
2855the MT constructor.
2856
2857=head2 $mt->init_plugins
2858
2859Loads any discoverable plugins that are available. This is called from
2860the C<init> method, after the C<init_config> method has loaded the
2861configuration settings.
2862
2863=head2 $mt->init_tasks
2864
2865Registers the standard set of periodic tasks that Movable Type provides
2866and then invokes the C<init_tasks> method for each available plugin.
2867
2868=head2 MT->run_tasks
2869
2870Initializes the tasks, running C<init_tasks> and invokes the task system
2871through L<MT::TaskMgr> to run any registered tasks that are pending
2872execution. See L<MT::TaskMgr> for further documentation.
2873
2874=head2 MT->unplug
2875
2876Removes the global reference to the MT instance.
2877
2878=head2 MT::log( $message ) or $mt->log( $message )
2879
2880Adds an entry to the application's log table. Also writes message to
2881STDERR which is typically routed to the web server's error log.
2882
2883=head2 $mt->server_path, $mt->mt_dir
2884
2885Both of these methods return the physical file path to the directory
2886that is the home of the MT installation. This would be the value of
2887the 'Directory' parameter given in the MT constructor, or would be
2888determined based on the path of the configuration file.
2889
2890=head2 $mt->app_dir
2891
2892Returns the physical file path to the active application directory. This
2893is determined by the directory of the active script.
2894
2895=head2 $mt->config_dir
2896
2897Returns the path to the MT configuration file.
2898
2899=head2 $mt->config([$setting[, $value]])
2900
2901This method is used to get and set configuration settings. When called
2902without any parameters, it returns the active MT::ConfigMgr instance
2903used by the application.
2904
2905Specifying the C<$setting> parameter will return the value for that setting.
2906When passing the C<$value> parameter, this will update the config object,
2907assigning that value for the named C<$setting>.
2908
2909=head2 $mt->user_class
2910
2911Returns the package name for the class used for user authentication.
2912This is typically L<MT::Author>.
2913
2914=head2 $mt->request([$element[,$data]])
2915
2916The request method provides a request-scoped storage object. It is an
2917access interface for the L<MT::Request> package. Calling without any
2918parameters will return the L<MT::Request> instance.
2919
2920When called with the C<$element> parameter, the data stored for that
2921element is returned (or undef, if it didn't exist). When called with
2922the C<$data> parameter, it will store the data into the specified
2923element in the request object.
2924
2925All values placed in the request object are lost at the end of the
2926request. If the running application is not a web-based application,
2927the request object exists for the lifetime of the process and is
2928released when the process ends.
2929
2930See the L<MT::Request> package for more information.
2931
2932=head2 MT->new_ua
2933
2934Returns a new L<LWP::UserAgent> instance that is configured according to the
2935Movable Type configuration settings (specifically C<HTTPInterface>, C<HTTPTimeout>, C<HTTPProxy> and C<HTTPNoProxy>). The agent string is set
2936to "MovableType/(version)" and is also limited to receiving a response of
2937100,000 bytes by default (you can override this by using the 'max_size'
2938method on the returned instance). Using this method is recommended for
2939any HTTP requests issued by Movable Type since it uses the MT configuration
2940settings to prepare the UserAgent object.
2941
2942=head2 $mt->ping( %args )
2943
2944Sends all configured XML-RPC pings as a way of notifying other community
2945sites that your blog has been updated.
2946
2947I<%args> can contain:
2948
2949=over 4
2950
2951=item * Blog
2952
2953An I<MT::Blog> object corresponding to the blog for which you would like to
2954send the pings.
2955
2956Either this or C<BlogID> is required.
2957
2958=item * BlogID
2959
2960The ID of the blog for which you would like to send the pings.
2961
2962Either this or C<Blog> is required.
2963
2964=back
2965
2966=head2 $mt->ping_and_save( %args )
2967
2968Handles the task of issuing any pending ping operations for a given
2969entry and then saving that entry back to the database.
2970
2971The I<%args> hash should contain an element named C<Entry> that is a
2972reference to a L<MT::Entry> object.
2973
2974=head2 $mt->needs_ping(%param)
2975
2976Returns a list of URLs that have not been pinged for a given entry. Named
2977parameters for this method are:
2978
2979=over 4
2980
2981=item Entry
2982
2983The L<MT::Entry> object to examine.
2984
2985=item Blog
2986
2987The L<MT::Blog> object that is the parent of the entry given.
2988
2989=back
2990
2991The return value is an array reference of URLs that have not been pinged
2992for the given entry.
2993
2994An empty list is returned for entries that have a non 'RELEASE' status.
2995
2996=head2 $mt->update_ping_list($blog)
2997
2998Returns a list of URLs for ping services that have been configured to
2999be notified when posting new entries.
3000
3001=head2 $mt->set_language($tag)
3002
3003Loads the localization plugin for the language specified by I<$tag>, which
3004should be a valid and supported language tag--see I<supported_languages> to
3005obtain a list of supported languages.
3006
3007The language is set on a global level, and affects error messages and all
3008text in the administration system.
3009
3010This method can be called as either a class method or an object method; in
3011other words,
3012
3013    MT->set_language($tag)
3014
3015will also work. However, the setting will still be global--it will not be
3016specified to the I<$mt> object.
3017
3018The default setting--set when I<MT::new> is called--is U.S. English. If a
3019I<DefaultLanguage> is set in the MT configuration file, the default is then
3020set to that language.
3021
3022=head2 MT->translate($str[, $param, ...])
3023
3024Translates I<$str> into the currently-set language (set by I<set_language>),
3025and returns the translated string. Any parameters following I<$str> are
3026passed through to the C<maketext> method of the active localization module.
3027
3028=head2 MT->translate_templatized($str)
3029
3030Translates a string that has embedded E<lt>MT_TRANSE<gt> tags. These
3031tags identify the portions of the string that require localization.
3032Each tag is processed separately and passed through the MT->translate
3033method. Examples (used in your application's HTML::Template templates):
3034
3035    <p><MT_TRANS phrase="Hello, world"></p>
3036
3037and
3038
3039    <p><MT_TRANS phrase="Hello, [_1]" params="<TMPL_VAR NAME=NAME>"></p>
3040
3041=head2 $mt->trans_error( $str[, $arg1, $arg2] )
3042
3043Translates I<$str> into the currently-set language (set by I<set_language>),
3044and assigns it as the active error for the MT instance. It returns undef,
3045which is the usual return value upon generating an error in the application.
3046So when an error occurs, the typical return result would be:
3047
3048    if ($@) {
3049        return $app->trans_error("An error occurred: [_1]", $@);
3050    }
3051
3052The optional I<$arg1> (and so forth) parameters are passed as parameters to
3053any parameterized error message.
3054
3055=head2 $mt->current_language
3056
3057Returns the language tag for the currently-set language.
3058
3059=head2 MT->supported_languages
3060
3061Returns a reference to an associative array mapping language tags to their
3062proper names. For example:
3063
3064    use MT;
3065    my $langs = MT->supported_languages;
3066    print map { $_ . " => " . $langs->{$_} . "\n" } keys %$langs;
3067
3068=head2 MT->language_handle
3069
3070Returns the active MT::L10N language instance for the active language.
3071
3072=head2 MT->add_plugin($plugin)
3073
3074Adds the plugin described by $plugin to the list of plugins displayed
3075on the welcome page. The argument should be an object of the
3076I<MT::Plugin> class.
3077
3078=head2 MT->all_text_filters
3079
3080Returns a reference to a hash containing the registry of text filters.
3081
3082=head2 MT->apply_text_filters($str, \@filters)
3083
3084Applies the set of filters I<\@filters> to the string I<$str> and returns
3085the result (the filtered string).
3086
3087I<\@filters> should be a reference to an array of filter keynames--these
3088are the short names passed in as the first argument to I<add_text_filter>.
3089I<$str> should be a scalar string to be filtered.
3090
3091If one of the filters listed in I<\@filters> is not found in the list of
3092registered filters (that is, filters added through I<add_text_filter>),
3093it will be skipped silently. Filters are executed in the order in which they
3094appear in I<\@filters>.
3095
3096As it turns out, the I<MT::Entry::text_filters> method returns a reference
3097to the list of text filters to be used for that entry. So, for example, to
3098use this method to apply filters to the main entry text for an entry
3099I<$entry>, you would use
3100
3101    my $out = MT->apply_text_filters($entry->text, $entry->text_filters);
3102
3103=head2 MT->add_callback($meth, $priority, $plugin, $code)
3104
3105Registers a new callback handler for a particular registered callback.
3106
3107The first parameter is the name of the callback method. The second
3108parameter is a priority (a number in the range of 1-10) which will control
3109the order that the handler is executed in relation to other handlers. If
3110two handlers register with the same priority, they will be executed in
3111the order that they registered. The third parameter is a C<MT::Plugin> object
3112reference that is associated with the handler (this parameter is optional).
3113The fourth parameter is a code reference that is invoked to handle the
3114callback. For example:
3115
3116    MT->add_callback('BuildFile', 1, undef, \&rebuild_file_hdlr);
3117
3118The code reference should expect to receive an object of type
3119L<MT::Callback> as its first argument. This object is used to
3120communicate errors to the caller:
3121
3122    sub rebuild_file_hdlr {
3123        my ($cb, ...) = @_;
3124        if (something bad happens) {
3125            return $cb->error("Something bad happened!");
3126        }
3127    }
3128
3129Other parameters to the callback function depend on the callback point.
3130
3131The treatment of the error string depends on the callback point.
3132Typically, either it is ignored or the user's action fails and the
3133error message is displayed.
3134
3135The value returned from this method is the new L<MT::Callback> object.
3136
3137=head2 MT->remove_callback($callback)
3138
3139Removes a callback that was previously registered.
3140
3141=head2 MT->register_callbacks([...])
3142
3143Registers several callbacks simultaneously. Each element in the array
3144parameter given should be a hashref containing these elements: C<name>,
3145C<priority>, C<plugin> and C<code>.
3146
3147=head2 MT->run_callbacks($meth[, $arg1, $arg2, ...])
3148
3149Invokes a particular callback, running any associated callback handlers.
3150
3151The first parameter is the name of the callback to execute. This is one
3152of the global callback methods (see L<Callbacks> section) or can be
3153a class-specific method that includes the package name associated with
3154the callback.
3155
3156The remaining arguments are passed through to any callback handlers that
3157are invoked.
3158
3159For "Filter"-type callbacks, this routine will return a 0 if any of the
3160handlers return a false result. If all handlers return a true result,
3161a value of 1 is returned.
3162
3163Example:
3164
3165    MT->run_callbacks('MyClass::frobnitzes', \@whirlygigs);
3166
3167Which would execute any handlers that registered in this fashion:
3168
3169    MT->add_callback('MyClass::frobnitzes', 4, $plugin, \&frobnitz_hdlr);
3170
3171=head2 MT->run_callback($cb[, $arg1, $arg2, ...])
3172
3173An internal routine used by C<run_callbacks> to invoke a single
3174L<MT::Callback>.
3175
3176=head2 callback_error($str)
3177
3178This routine is used internally by C<MT::Callback> to set any error response
3179that comes from invoking a callback.
3180
3181=head2 callback_errstr
3182
3183This internal routine returns the error response stored using the
3184C<callback_error> routine.
3185
3186=head2 MT->product_code
3187
3188The product code identifying the Movable Type product that is installed.
3189This is either 'MTE' for Movable Type Enterprise or 'MT' for the
3190non-Enterprise product.
3191
3192=head2 MT->product_name
3193
3194The name of the Movable Type product that is installed. This is either
3195'Movable Type Enterprise' or 'Movable Type Publishing Platform'.
3196
3197=head2 MT->product_version
3198
3199The version number of the product. This is different from the C<version_id>
3200and C<version_number> methods as they report the API version information.
3201
3202=head2 MT->version_id
3203
3204Returns the API version of MT (including any beta/alpha designations).
3205
3206=head2 MT->version_number
3207
3208Returns the numeric API version of MT (without any beta/alpha designations).
3209For example, if I<version_id> returned C<2.5b1>, I<version_number> would
3210return C<2.5>.
3211
3212=head2 MT->schema_version
3213
3214Returns the version of the MT database schema.
3215
3216=head2 MT->version_slug
3217
3218Returns a string of text that is appended to emails sent through the
3219C<build_email> method.
3220
3221=head2 $mt->publisher
3222
3223Returns the L<MT::WeblogPublisher> object that is used for managing the
3224MT publishing process. See L<MT::WeblogPublisher> for more information.
3225
3226=head2 $mt->rebuild
3227
3228An alias to L<MT::WeblogPublisher::rebuild>. See L<MT::WeblogPublisher>
3229for documentation of this method.
3230
3231=head2 $mt->rebuild_entry
3232
3233An alias to L<MT::WeblogPublisher::rebuild_entry>. See L<MT::WeblogPublisher>
3234for documentation of this method.
3235
3236=head2 $mt->rebuild_indexes
3237
3238An alias to L<MT::WeblogPublisher::rebuild_indexes>. See
3239L<MT::WeblogPublisher> for documentation of this method.
3240
3241=head2 $mt->build_email($file, $param)
3242
3243Loads a template from the application's 'email' template directory and
3244processes it as a HTML::Template. The C<$param> argument is a hash reference
3245of parameter data for the template. The return value is the output of the
3246template.
3247
3248=head2 MT::get_next_sched_post_for_user($author_id, @blog_ids)
3249
3250This is an internal routine used by L<MT::XMLRPCServer> and the
3251getNextScheduled XMLRPC method to determine the timestamp for the next
3252entry that is scheduled for publishing. The return value is the timestamp
3253in UTC time in the format "YYYY-MM-DDTHH:MM:SSZ".
3254
3255=head1 ERROR HANDLING
3256
3257On an error, all of the above methods return C<undef>, and the error message
3258can be obtained by calling the method I<errstr> on the class or the object
3259(depending on whether the method called was a class method or an instance
3260method).
3261
3262For example, called on a class name:
3263
3264    my $mt = MT->new or die MT->errstr;
3265
3266Or, called on an object:
3267
3268    $mt->rebuild(BlogID => $blog_id)
3269        or die $mt->errstr;
3270
3271=head1 DEBUGGING
3272
3273MT has a package variable C<$MT::DebugMode> which is assigned through
3274your MT configuration file (DebugMode setting). If this is set to
3275any non-zero value, MT applications will display any C<warn>'d
3276statements to a panel that is displayed within the app.
3277
3278The DebugMode is a bit-wise setting and offers the following options:
3279
3280    1 - Display debug messages
3281    2 - Display a stack trace for messages captured
3282    4 - Lists queries issued by Data::ObjectDriver
3283    8 - Reports on MT templates that take more than 1/4 second to build*
3284    128 - Outputs app-level request/response information to STDERR.
3285
3286These can be combined, so if you want to display queries and debug messages,
3287use a DebugMode of 5 for instance.
3288
3289You may also use the local statement to temporarily apply a particular bit,
3290if you want to scope the debug messages you receive to a block of code:
3291
3292    local $MT::DebugMode |= 4;  # show me the queries for the following
3293    my $obj = MT::Entry->load({....});
3294
3295*DebugMode bit 8 actually outputs it's messages to STDERR (which typically
3296is sent to your web server's error log).
3297
3298=head1 CALLBACKS
3299
3300Movable Type has a variety of hook points at which a plugin can attach
3301a callback.
3302
3303In each case, the first parameter is an L<MT::Callback> object which
3304can be used to pass error information back to the caller.
3305
3306The app-level callbacks related to rebuilding are documented
3307in L<MT::WeblogPublisher>. The specific apps document the callbacks
3308which they invoke.
3309
3310=head2 NewUserProvisioning($cb, $user)
3311
3312This callback is invoked when a user is being added to Movable Type.
3313Movable Type itself registers for this callback (with a priority of 5)
3314to provision the user with a new weblog if the system has been configured
3315to do so.
3316
3317=head1 LICENSE
3318
3319The license that applies is the one you agreed to when downloading
3320Movable Type.
3321
3322=head1 AUTHOR & COPYRIGHT
3323
3324Except where otherwise noted, MT is Copyright 2001-2008 Six Apart.
3325All rights reserved.
3326
3327=cut
Note: See TracBrowser for help on using the browser.