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

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

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