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

Revision 1372, 104.0 kB (checked in by bchoate, 22 months ago)

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