root/branches/mt4.11/lib/MT.pm.pre @ 1380

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

Added 'PerformanceLoggingPath' setting to allow configuration of path for performance logs. BugId:68319
  • 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    my $dir = $pkg->config->PerformanceLoggingPath;
913    if (! -d $dir) {
914        require File::Path;
915        eval { File::Path::mkpath([$dir], 0, 0777) };
916        if ($@) {
917            $log_file = 0;
918            return;
919        }
920    }
921    my @time = localtime(time);
922    my $file = sprintf("pl-%04d%02d%02d.log", $time[5] + 1900, $time[4]+1, $time[3]);
923    $log_file = File::Spec->catfile( $dir, $file );
924
925    my $first_write = ! -f $log_file;
926
927    local *PERFLOG;
928    open PERFLOG, ">>$log_file";
929    require Fcntl;
930    flock(PERFLOG, Fcntl::LOCK_EX());
931
932    if ($first_write) {
933        require Config;
934        my ($osname, $osvers) = ($Config::Config{osname}, $Config::Config{osvers});
935        print PERFLOG "# Operating System: $osname/$osvers\n";
936        print PERFLOG "# Platform: $^O\n";
937        my $ver = ref($^V) eq 'version' ? $^V->normal : ( $^V ? join('.', unpack 'C*', $^V) : $] );
938        print PERFLOG "# Perl Version: $ver\n";
939        print PERFLOG "# Web Server: $ENV{SERVER_SOFTWARE}\n";
940        require MT::Object;
941        my $driver = MT::Object->driver;
942        if ($driver) {
943            my $dbh = $driver->r_handle;
944            if ($dbh) {
945                my $dbname = $dbh->get_info( 17 ); # SQL_DBMS_NAME
946                my $dbver = $dbh->get_info( 18 ); # SQL_DBMS_VER
947                if ($dbname && $dbver) {
948                    print PERFLOG "# Database: $dbname/$dbver\n";
949                }
950            }
951        }
952        my ($drname, $drh) = each %DBI::installed_drh;
953        print PERFLOG "# Database Library: DBI/" . $DBI::VERSION . "; DBD/" . $drh->{Version} . "\n";
954        if ($ENV{MOD_PERL}) {
955            print PERFLOG "# App Mode: mod_perl\n";
956        }
957        elsif ($ENV{FAST_CGI}) {
958            print PERFLOG "# App Mode: FastCGI\n";
959        }
960        else {
961            print PERFLOG "# App Mode: CGI\n";
962        }
963    }
964
965    if ($memory) {
966        print PERFLOG $timer->dump_line("mem_start=$memory_start", "mem_end=$memory");
967    } else {
968        print PERFLOG $timer->dump_line();
969    }
970
971    close PERFLOG;
972}
973}
974
975sub get_timer {
976    my $mt = shift;
977    $mt = MT->instance unless ref $mt;
978    my $timer = $mt->request('timer');
979    unless ($timer) {
980        my $uri;
981        if ($mt->isa('MT::App')) {
982            $uri = $mt->uri( $mt->request_method eq 'GET' ? ( args => { $mt->param_hash } ) : () );
983        }
984        require MT::Util::ReqTimer;
985        $timer = MT::Util::ReqTimer->new( $uri );
986        $mt->request('timer', $timer);
987    }
988    return $timer;
989}
990
991sub time_this {
992    my $mt = shift;
993    my ($str, $code) = @_;
994    my $timer = $mt->get_timer();
995    my $ret;
996    if ($timer) {
997        $timer->pause_partial();
998        $ret = $code->();
999        $timer->mark($str);
1000    } else {
1001        $ret = $code->();
1002    }
1003    return $ret;
1004}
1005
1006sub init_config_from_db {
1007    my $mt = shift;
1008    my ($param) = @_;
1009    my $cfg = $mt->config;
1010    $cfg->read_config_db();
1011
1012    # Tell any instantiated drivers to reconfigure themselves as necessary
1013    MT::ObjectDriverFactory->configure;
1014
1015    1;
1016}
1017
1018sub bootstrap {
1019    my $pkg = shift;
1020    $pkg->init_paths() or return;
1021    $pkg->init_core()  or return;
1022}
1023
1024sub init_paths {
1025    my $mt = shift;
1026    my ($param) = @_;
1027
1028    # determine MT directory
1029    my ($orig_dir);
1030    require File::Spec;
1031    if ( !( $MT_DIR = $ENV{MT_HOME} ) ) {
1032        if ( $0 =~ m!(.*([/\\]))! ) {
1033            $orig_dir = $MT_DIR = $1;
1034            my $slash = $2;
1035            $MT_DIR =~ s!(?:[/\\]|^)(?:plugins[/\\].*|tools[/\\])$!$slash!;
1036            $MT_DIR = '' if ( $MT_DIR =~ m!^\.?[\\/]$! );
1037        }
1038        else {
1039
1040            # MT_DIR/lib/MT.pm -> MT_DIR/lib -> MT_DIR
1041            $MT_DIR = dirname( dirname( File::Spec->rel2abs(__FILE__) ) );
1042        }
1043        unless ($MT_DIR) {
1044            $orig_dir = $MT_DIR = $ENV{PWD} || '.';
1045            $MT_DIR =~ s!(?:[/\\]|^)(?:plugins[/\\].*|tools[/\\]?)$!!;
1046        }
1047        $ENV{MT_HOME} = $MT_DIR;
1048    }
1049    unshift @INC, File::Spec->catdir( $MT_DIR,   'extlib' );
1050    unshift @INC, File::Spec->catdir( $orig_dir, 'lib' )
1051      if $orig_dir && ( $orig_dir ne $MT_DIR );
1052
1053    $mt->set_language('__BUILD_LANGUAGE__');
1054
1055    if ( my $cfg_file = $mt->find_config($param) ) {
1056        $cfg_file = File::Spec->rel2abs($cfg_file);
1057        $CFG_FILE = $cfg_file;
1058    }
1059    else {
1060        return $mt->trans_error(
1061"Missing configuration file. Maybe you forgot to move mt-config.cgi-original to mt-config.cgi?"
1062        ) if ref($mt);
1063    }
1064
1065    # store the mt_dir (home) as an absolute path; fallback to the config
1066    # directory if it isn't set.
1067    $MT_DIR ||=
1068      $param->{directory}
1069      ? File::Spec->rel2abs( $param->{directory} )
1070      : $CFG_DIR;
1071    $MT_DIR ||= dirname($0);
1072
1073    # also make note of the active application path; this is derived by
1074    # checking the PWD environment variable, the dirname of $0,
1075    # the directory of SCRIPT_FILENAME and lastly, falls back to mt_dir
1076    $APP_DIR = $ENV{PWD} || "";
1077    $APP_DIR = dirname($0)
1078      if !$APP_DIR || !File::Spec->file_name_is_absolute($APP_DIR);
1079    $APP_DIR = dirname( $ENV{SCRIPT_FILENAME} )
1080      if $ENV{SCRIPT_FILENAME}
1081      && ( !$APP_DIR || ( !File::Spec->file_name_is_absolute($APP_DIR) ) );
1082    $APP_DIR ||= $MT_DIR;
1083    $APP_DIR = File::Spec->rel2abs($APP_DIR);
1084
1085    return 1;
1086}
1087
1088sub init_core {
1089    my $mt = shift;
1090    return if exists $Components{'core'};
1091    require MT::Core;
1092    my $c = MT::Core->new( { id => 'core', path => $MT_DIR } )
1093      or die MT::Core->errstr;
1094    $Components{'core'} = $c;
1095
1096    # Additional locale-specific defaults
1097    my $defaults = $c->{registry}{config_settings};
1098    $defaults->{DefaultLanguage}{default} = '__BUILD_LANGUAGE__';
1099    $defaults->{NewsboxURL}{default} = '__NEWSBOX_URL__';
1100    $defaults->{LearningNewsURL}{default} = '__LEARNINGNEWS_URL__';
1101    $defaults->{SupportURL}{default} = '__SUPPORT_URL__';
1102    $defaults->{NewsURL}{default} = '__NEWS_URL__';
1103    #$defaults->{HelpURL}{default} = '__HELP_URL__';
1104    $defaults->{DefaultTimezone}{default} = '__DEFAULT_TIMEZONE__';
1105    $defaults->{MailEncoding}{default} = '__MAIL_ENCODING__';
1106    $defaults->{ExportEncoding}{default} = '__EXPORT_ENCODING__';
1107    $defaults->{LogExportEncoding}{default} = '__LOG_EXPORT_ENCODING__';
1108    $defaults->{CategoryNameNodash}{default} = '__CATEGORY_NAME_NODASH__';
1109    $defaults->{PublishCharset}{default} = '__PUBLISH_CHARSET__';
1110
1111    push @Components, $c;
1112    return 1;
1113}
1114
1115sub init {
1116    my $mt    = shift;
1117    my %param = @_;
1118
1119    $mt->bootstrap() unless $MT_DIR;
1120    $mt->{mt_dir}     = $MT_DIR;
1121    $mt->{config_dir} = $CFG_DIR;
1122    $mt->{app_dir}    = $APP_DIR;
1123
1124    $mt->init_callbacks();
1125
1126    ## Initialize the language to the default in case any errors occur in
1127    ## the rest of the initialization process.
1128    $mt->init_config( \%param ) or return;
1129    $mt->init_addons(@_)       or return;
1130    $mt->init_config_from_db( \%param ) or return;
1131    $mt->init_plugins(@_)       or return;
1132    $plugins_installed = 1;
1133    $mt->init_schema();
1134    $mt->init_permissions();
1135
1136    # Load MT::Log so constants are available
1137    require MT::Log;
1138
1139    return $mt;
1140}
1141
1142sub init_callbacks {
1143    my $mt = shift;
1144    MT->_register_core_callbacks({
1145        'build_file_filter' => sub { MT->publisher->queue_build_file_filter(@_) },
1146        'cms_upload_file' => \&core_upload_file_to_sync,
1147        'api_upload_file' => \&core_upload_file_to_sync,
1148    });
1149}
1150
1151sub core_upload_file_to_sync {
1152    my ($cb, %args) = @_;
1153
1154    # no need to do this unless we're syncing stuff.
1155    return unless MT->config('SyncTarget');
1156
1157    my $url = $args{url};
1158    my $file = $args{file};
1159    return unless -f $file;
1160
1161    my $blog = $args{blog};
1162    my $blog_id = $blog->id;
1163    return unless $blog->publish_queue;
1164
1165    require MT::FileInfo;
1166    my $base_url = $url;
1167    $base_url =~ s!^https?://[^/]+!!;
1168    my $fi = MT::FileInfo->load({ blog_id => $blog_id, url => $base_url });
1169    if (!$fi) {
1170        $fi = new MT::FileInfo;
1171        $fi->blog_id($blog_id);
1172        $fi->url($base_url);
1173        $fi->file_path($file);
1174    } else {
1175        $fi->file_path($file);
1176    }
1177    $fi->save;
1178
1179    require MT::TheSchwartz;
1180    require TheSchwartz::Job;
1181    my $job = TheSchwartz::Job->new();
1182    $job->funcname('MT::Worker::Sync');
1183    $job->uniqkey( $fi->id );
1184    $job->coalesce( $$ . ':' . ( time - ( time % 100 ) ) );
1185    MT::TheSchwartz->insert($job);
1186}
1187
1188sub init_addons {
1189    my $mt = shift;
1190    my $cfg = $mt->config;
1191    my @PluginPaths;
1192
1193    unshift @PluginPaths, File::Spec->catdir( $MT_DIR, 'addons' );
1194    return $mt->_init_plugins_core({}, 1, \@PluginPaths);
1195}
1196
1197sub init_plugins {
1198    my $mt = shift;
1199
1200    # Load compatibility module for prior version
1201    # This should always be MT::Compat::v(MAJOR_RELEASE_VERSION - 1).
1202    require MT::Compat::v3;
1203
1204    require MT::Plugin;
1205    my $cfg          = $mt->config;
1206    my $use_plugins  = $cfg->UsePlugins;
1207    my @PluginPaths  = $cfg->PluginPath;
1208    my $PluginSwitch = $cfg->PluginSwitch || {};
1209    return $mt->_init_plugins_core($PluginSwitch, $use_plugins, \@PluginPaths);
1210}
1211
1212sub _init_plugins_core {
1213    my $mt = shift;
1214    my ($PluginSwitch, $use_plugins, $PluginPaths) = @_;
1215
1216    my $timer;
1217    if ($mt->config->PerformanceLogging) {
1218        $timer = $mt->get_timer();
1219    }
1220
1221    foreach my $PluginPath (@$PluginPaths) {
1222        my $plugin_lastdir = $PluginPath;
1223        $plugin_lastdir =~ s![\\/]$!!;
1224        $plugin_lastdir =~ s!.*[\\/]!!;
1225        local *DH;
1226        if ( opendir DH, $PluginPath ) {
1227            my @p = readdir DH;
1228          PLUGIN:
1229            for my $plugin (@p) {
1230                next if ( $plugin =~ /^\.\.?$/ || $plugin =~ /~$/ );
1231
1232                my $load_plugin = sub {
1233                    my ( $plugin, $sig ) = @_;
1234                    die "Bad plugin filename '$plugin'"
1235                      if ( $plugin !~ /^([-\\\/\@\:\w\.\s~]+)$/ );
1236                    local $plugin_sig      = $sig;
1237                    local $plugin_registry = {};
1238                    $plugin = $1;
1239                    if (
1240                        !$use_plugins
1241                        || ( exists $PluginSwitch->{$plugin_sig}
1242                            && !$PluginSwitch->{$plugin_sig} )
1243                      )
1244                    {
1245                        $Plugins{$plugin_sig}{full_path} = $plugin_full_path;
1246                        $Plugins{$plugin_sig}{enabled}   = 0;
1247                        return 0;
1248                    }
1249                    return 0 if exists $Plugins{$plugin_sig};
1250                    $Plugins{$plugin_sig}{full_path} = $plugin_full_path;
1251                    $timer->pause_partial if $timer;
1252                    eval { require $plugin };
1253                    $timer->mark("Loaded plugin " . $sig) if $timer;
1254                    if ($@) {
1255                        $Plugins{$plugin_sig}{error} = $@;
1256                        # Issue MT log within another eval block in the
1257                        # event that the plugin error is happening before
1258                        # the database has been initialized...
1259                        eval {
1260                            require MT::Log;
1261                            $mt->log(
1262                                {
1263                                    message => $mt->translate(
1264                                        "Plugin error: [_1] [_2]", $plugin,
1265                                        $Plugins{$plugin_sig}{error}
1266                                    ),
1267                                    class => 'system',
1268                                    level => MT::Log::ERROR()
1269                                }
1270                            );
1271                        };
1272                        return 0;
1273                    }
1274                    else {
1275                        if ( my $obj = $Plugins{$plugin_sig}{object} ) {
1276                            $obj->init_callbacks();
1277                        }
1278                        else {
1279
1280                            # A plugin did not register itself, so
1281                            # create a dummy plugin object which will
1282                            # cause it to show up in the plugin listing
1283                            # by it's filename.
1284                            MT->add_plugin( {} );
1285                        }
1286                    }
1287                    $Plugins{$plugin_sig}{enabled} = 1;
1288                    return 1;
1289                };
1290                $plugin_full_path = File::Spec->catfile( $PluginPath, $plugin );
1291                if ( -f $plugin_full_path ) {
1292                    $plugin_envelope = $plugin_lastdir;
1293                    $load_plugin->( $plugin_full_path, $plugin )
1294                      if $plugin_full_path =~ /\.pl$/;
1295                }
1296                else {
1297                    my $plugin_dir = $plugin;
1298                    $plugin_envelope = "$plugin_lastdir/" . $plugin;
1299
1300                    # handle config.yaml
1301                    my $yaml =
1302                      File::Spec->catdir( $plugin_full_path, 'config.yaml' );
1303                    my $libdir;
1304                    ( unshift @INC, $libdir )
1305                      if -d ( $libdir =
1306                          File::Spec->catdir( $plugin_full_path, 'lib' ) );
1307                    if ( -f $yaml ) {
1308                        my $pclass =
1309                          $plugin_dir =~ m/\.pack$/
1310                          ? 'MT::Component'
1311                          : 'MT::Plugin';
1312
1313                        # Don't process disabled plugin config.yaml files.
1314                        if (
1315                            $pclass eq 'MT::Plugin'
1316                            && (
1317                                !$use_plugins
1318                                || ( exists $PluginSwitch->{$plugin_dir}
1319                                    && !$PluginSwitch->{$plugin_dir} )
1320                            )
1321                          )
1322                        {
1323                            $Plugins{$plugin_dir}{full_path} =
1324                              $plugin_full_path;
1325                            $Plugins{$plugin_dir}{enabled} = 0;
1326                            next;
1327                        }
1328                        my $id = lc $plugin_dir;
1329                        $id =~ s/\.\w+$//;
1330                        my $p = $pclass->new(
1331                            {
1332                                id       => $id,
1333                                path     => $plugin_full_path,
1334                                envelope => $plugin_envelope
1335                            }
1336                        );
1337
1338                        # rebless? based on config?
1339                        local $plugin_sig = $plugin_dir;
1340                        MT->add_plugin($p);
1341                        $p->init_callbacks()
1342                            if $pclass eq 'MT::Plugin';
1343                        next;
1344                    }
1345
1346                    opendir SUBDIR, $plugin_full_path;
1347                    my @plugins = readdir SUBDIR;
1348                    closedir SUBDIR;
1349                    for my $plugin (@plugins) {
1350                        next if $plugin !~ /\.pl$/;
1351                        my $plugin_file =
1352                          File::Spec->catfile( $plugin_full_path, $plugin );
1353                        if ( -f $plugin_file ) {
1354                            $load_plugin->(
1355                                $plugin_file, $plugin_dir . '/' . $plugin
1356                            );
1357                        }
1358                    }
1359                }
1360            }
1361            closedir DH;
1362        }
1363    }
1364
1365    # Reset the Text_filters hash in case it was preloaded by plugins by
1366    # calling all_text_filters (Markdown in particular does this).
1367    # Upon calling all_text_filters again, it will be properly loaded by
1368    # querying the registry.
1369    %Text_filters = ();
1370
1371    1;
1372}
1373
1374my %addons;
1375
1376sub find_addons {
1377    my $mt = shift;
1378    my ($type) = @_;
1379
1380    unless (%addons) {
1381        my $addon_path = File::Spec->catdir( $MT_DIR, 'addons' );
1382        local *DH;
1383        if ( opendir DH, $addon_path ) {
1384            my @p = readdir DH;
1385            foreach my $p (@p) {
1386                next if $p eq '.' || $p eq '..';
1387                my $full_path = File::Spec->catdir( $addon_path, $p );
1388                if ( -d $full_path ) {
1389                    if ( $p =~ m/^(.+)\.(\w+)$/ ) {
1390                        my $label = $1;
1391                        my $id    = lc $1;
1392                        my $type  = $2;
1393                        if ( $type eq 'pack' ) {
1394                            $label .= ' Pack';
1395                        }
1396                        elsif ( $type eq 'theme' ) {
1397                            $label .= ' Theme';
1398                        }
1399                        elsif ( $type eq 'plugin' ) {
1400                            $label .= ' Plugin';
1401                        }
1402                        push @{ $addons{$type} },
1403                          {
1404                            label    => $label,
1405                            id       => $id,
1406                            envelope => 'addons/' . $p . '/',
1407                            path     => $full_path,
1408                          };
1409                    }
1410                }
1411            }
1412        }
1413    }
1414    if ($type) {
1415        my $addons = $addons{$type} ||= [];
1416        return $addons;
1417    }
1418    return 1;
1419}
1420
1421*mt_dir = \&server_path;
1422sub server_path { $_[0]->{mt_dir} }
1423sub app_dir     { $_[0]->{app_dir} }
1424sub config_dir  { $_[0]->{config_dir} }
1425
1426sub component {
1427    my $mt = shift;
1428    my ($id) = @_;
1429    return $Components{ lc $id };
1430}
1431
1432sub publisher {
1433    my $mt = shift;
1434    $mt = $mt->instance unless ref $mt;
1435    unless ( $mt->{WeblogPublisher} ) {
1436        require MT::WeblogPublisher;
1437        $mt->{WeblogPublisher} = new MT::WeblogPublisher();
1438    }
1439    $mt->{WeblogPublisher};
1440}
1441
1442sub rebuild {
1443    my $mt = shift;
1444    $mt->publisher->rebuild(@_)
1445      or return $mt->error( $mt->publisher->errstr );
1446}
1447
1448sub rebuild_entry {
1449    my $mt = shift;
1450    $mt->publisher->rebuild_entry(@_)
1451      or return $mt->error( $mt->publisher->errstr );
1452}
1453
1454sub rebuild_indexes {
1455    my $mt = shift;
1456    $mt->publisher->rebuild_indexes(@_)
1457      or return $mt->error( $mt->publisher->errstr );
1458}
1459
1460sub ping {
1461    my $mt    = shift;
1462    my %param = @_;
1463    my $blog;
1464    require MT::Entry;
1465    require MT::Util;
1466    unless ( $blog = $param{Blog} ) {
1467        my $blog_id = $param{BlogID};
1468        $blog = MT::Blog->load($blog_id)
1469          or return $mt->trans_error( "Load of blog '[_1]' failed: [_2]",
1470            $blog_id, MT::Blog->errstr );
1471    }
1472
1473    my (@res);
1474
1475    my $send_updates = 1;
1476    if ( exists $param{OldStatus} ) {
1477        ## If this is a new entry (!$old_status) OR the status was previously
1478        ## set to draft, and is now set to publish, send the update pings.
1479        my $old_status = $param{OldStatus};
1480        if ( $old_status && $old_status eq MT::Entry::RELEASE() ) {
1481            $send_updates = 0;
1482        }
1483    }
1484
1485    if ( $send_updates && !( MT->config->DisableNotificationPings ) ) {
1486        ## Send update pings.
1487        my @updates = $mt->update_ping_list($blog);
1488        for my $url (@updates) {
1489            require MT::XMLRPC;
1490            if ( MT::XMLRPC->ping_update( 'weblogUpdates.ping', $blog, $url ) )
1491            {
1492                push @res, { good => 1, url => $url, type => "update" };
1493            }
1494            else {
1495                push @res,
1496                  {
1497                    good  => 0,
1498                    url   => $url,
1499                    type  => "update",
1500                    error => MT::XMLRPC->errstr
1501                  };
1502            }
1503        }
1504        if ( $blog->mt_update_key ) {
1505            require MT::XMLRPC;
1506            if ( MT::XMLRPC->mt_ping($blog) ) {
1507                push @res,
1508                  {
1509                    good => 1,
1510                    url  => $mt->{cfg}->MTPingURL,
1511                    type => "update"
1512                  };
1513            }
1514            else {
1515                push @res,
1516                  {
1517                    good  => 0,
1518                    url   => $mt->{cfg}->MTPingURL,
1519                    type  => "update",
1520                    error => MT::XMLRPC->errstr
1521                  };
1522            }
1523        }
1524    }
1525
1526    my $cfg     = $mt->{cfg};
1527    my $send_tb = $cfg->OutboundTrackbackLimit;
1528    return \@res if $send_tb eq 'off';
1529
1530    my @tb_domains;
1531    if ( $send_tb eq 'selected' ) {
1532        @tb_domains = $cfg->OutboundTrackbackDomains;
1533    }
1534    elsif ( $send_tb eq 'local' ) {
1535        my $iter = MT::Blog->load_iter();
1536        while ( my $b = $iter->() ) {
1537            next if $b->id == $blog->id;
1538            push @tb_domains, MT::Util::extract_domains( $b->site_url );
1539        }
1540    }
1541    my $tb_domains;
1542    if (@tb_domains) {
1543        $tb_domains = '';
1544        my %seen;
1545        local $_;
1546        foreach (@tb_domains) {
1547            next unless $_;
1548            $_ = lc($_);
1549            next if $seen{$_};
1550            $tb_domains .= '|' if $tb_domains ne '';
1551            $tb_domains .= quotemeta($_);
1552            $seen{$_} = 1;
1553        }
1554        $tb_domains = '(' . $tb_domains . ')' if $tb_domains;
1555    }
1556
1557    ## Send TrackBack pings.
1558    if ( my $entry = $param{Entry} ) {
1559        my $pings = $entry->to_ping_url_list;
1560
1561        my %pinged = map { $_ => 1 } @{ $entry->pinged_url_list };
1562        my $cats = $entry->categories;
1563        for my $cat (@$cats) {
1564            push @$pings, grep !$pinged{$_}, @{ $cat->ping_url_list };
1565        }
1566
1567        my $ua = MT->new_ua;
1568
1569        ## Build query string to be sent on each ping.
1570        my @qs;
1571        push @qs, 'title=' . MT::Util::encode_url( $entry->title );
1572        push @qs, 'url=' . MT::Util::encode_url( $entry->permalink );
1573        push @qs, 'excerpt=' . MT::Util::encode_url( $entry->get_excerpt );
1574        push @qs, 'blog_name=' . MT::Util::encode_url( $blog->name );
1575        my $qs = join '&', @qs;
1576
1577        ## Character encoding--best guess.
1578        my $enc = $mt->{cfg}->PublishCharset;
1579
1580        for my $url (@$pings) {
1581            $url =~ s/^\s*//;
1582            $url =~ s/\s*$//;
1583            my $url_domain;
1584            ($url_domain) = MT::Util::extract_domains($url);
1585            next if $tb_domains && lc($url_domain) !~ m/$tb_domains$/;
1586
1587            my $req = HTTP::Request->new( POST => $url );
1588            $req->content_type(
1589                "application/x-www-form-urlencoded; charset=$enc");
1590            $req->content($qs);
1591            my $res = $ua->request($req);
1592            if ( substr( $res->code, 0, 1 ) eq '2' ) {
1593                my $c = $res->content;
1594                my ( $error, $msg ) =
1595                  $c =~ m!<error>(\d+).*<message>(.+?)</message>!s;
1596                if ($error) {
1597                    push @res,
1598                      {
1599                        good  => 0,
1600                        url   => $url,
1601                        type  => 'trackback',
1602                        error => $msg
1603                      };
1604                }
1605                else {
1606                    push @res, { good => 1, url => $url, type => 'trackback' };
1607                }
1608            }
1609            else {
1610                push @res,
1611                  {
1612                    good  => 0,
1613                    url   => $url,
1614                    type  => 'trackback',
1615                    error => "HTTP error: " . $res->status_line
1616                  };
1617            }
1618        }
1619    }
1620    \@res;
1621}
1622
1623sub ping_and_save {
1624    my $mt    = shift;
1625    my %param = @_;
1626    if ( my $entry = $param{Entry} ) {
1627        my $results = MT::ping( $mt, @_ ) or return;
1628        my %still_ping;
1629        my $pinged = $entry->pinged_url_list;
1630        for my $res (@$results) {
1631            next if $res->{type} ne 'trackback';
1632            if ( !$res->{good} ) {
1633                $still_ping{ $res->{url} } = 1;
1634            }
1635            push @$pinged,
1636              $res->{url}
1637              . ( $res->{good}
1638                ? ''
1639                : ' ' . MT::I18N::encode_text( $res->{error} ) );
1640        }
1641        $entry->pinged_urls( join "\n", @$pinged );
1642        $entry->to_ping_urls( join "\n", keys %still_ping );
1643        $entry->save or return $mt->error( $entry->errstr );
1644        return $results;
1645    }
1646    1;
1647}
1648
1649sub needs_ping {
1650    my $mt    = shift;
1651    my %param = @_;
1652    my $blog  = $param{Blog};
1653    my $entry = $param{Entry};
1654    require MT::Entry;
1655    return unless $entry->status == MT::Entry::RELEASE();
1656    my $old_status = $param{OldStatus};
1657    my %list;
1658    ## If this is a new entry (!$old_status) OR the status was previously
1659    ## set to draft, and is now set to publish, send the update pings.
1660    if ( ( !$old_status || $old_status ne MT::Entry::RELEASE() )
1661        && !( MT->config->DisableNotificationPings ) )
1662    {
1663        my @updates = $mt->update_ping_list($blog);
1664        @list{@updates} = (1) x @updates;
1665        $list{ $mt->{cfg}->MTPingURL } = 1 if $blog && $blog->mt_update_key;
1666    }
1667    if ($entry) {
1668        @list{ @{ $entry->to_ping_url_list } } = ();
1669        my %pinged = map { $_ => 1 } @{ $entry->pinged_url_list };
1670        my $cats = $entry->categories;
1671        for my $cat (@$cats) {
1672            @list{ grep !$pinged{$_}, @{ $cat->ping_url_list } } = ();
1673        }
1674    }
1675    my @list = keys %list;
1676    return unless @list;
1677    \@list;
1678}
1679
1680sub update_ping_list {
1681    my $mt = shift;
1682    my ($blog) = @_;
1683
1684    my @updates;
1685    if ( my $pings = MT->registry('ping_servers') ) {
1686        my $up = $blog->update_pings;
1687        if ($up) {
1688            foreach ( split ',', $up ) {
1689                next unless exists $pings->{$_};
1690                push @updates, $pings->{$_}->{url};
1691            }
1692        }
1693    }
1694    if ( my $others = $blog->ping_others ) {
1695        push @updates, split /\r?\n/, $others;
1696    }
1697    my %updates;
1698    for my $url (@updates) {
1699        for ($url) {
1700            s/^\s*//;
1701            s/\s*$//;
1702        }
1703        next unless $url =~ /\S/;
1704        $updates{$url}++;
1705    }
1706    keys %updates;
1707}
1708
1709{
1710    my $LH;
1711
1712    sub set_language {
1713        my $pkg = shift;
1714        require MT::L10N;
1715        $LH = MT::L10N->get_handle(@_);
1716
1717        # Clear any l10n_handles in request
1718        $pkg->request( 'l10n_handle', {} );
1719        return $LH;
1720    }
1721
1722    require MT::I18N;
1723
1724    sub translate {
1725        my $this = shift;
1726        my $app = ref($this) ? $this : $this->app;
1727        if ( $app->{component} ) {
1728            if ( my $c = $app->component( $app->{component} ) ) {
1729                local $app->{component} = undef;
1730                return $c->translate(@_);
1731            }
1732        }
1733        my ( $format, @args ) = @_;
1734        foreach (@args) {
1735            $_ = $_->() if ref($_) eq 'CODE';
1736        }
1737        my $enc = MT->instance->config('PublishCharset') || 'utf-8';
1738        return $LH->maketext( $format, @args ) if $enc =~ m/utf-?8/i;
1739        $format = MT::I18N::encode_text( $format, $enc, 'utf-8' );
1740        MT::I18N::encode_text(
1741            $LH->maketext(
1742                $format,
1743                map { MT::I18N::encode_text( $_, $enc, 'utf-8' ) } @args
1744            ),
1745            'utf-8', $enc
1746        );
1747    }
1748
1749    sub translate_templatized {
1750        my $mt = shift;
1751        my $app = ref($mt) ? $mt : $mt->app;
1752        if ( $app->{component} ) {
1753            if ( my $c = $app->component( $app->{component} ) ) {
1754                local $app->{component} = undef;
1755                return $c->translate_templatized(@_);
1756            }
1757        }
1758        my @cstack;
1759        my ($text) = @_;
1760        while (1) {
1761            $text =~ s!(<(/)?(?:_|MT)_TRANS(_SECTION)?(?:(?:\s+((?:\w+)\s*=\s*(["'])(?:(<(?:[^"'>]|"[^"]*"|'[^']*')+)?>|[^\5]+?)*?\5))+?\s*/?)?>)!
1762            my($msg, $close, $section, %args) = ($1, $2, $3);
1763            while ($msg =~ /\b(\w+)\s*=\s*(["'])((?:<(?:[^"'>]|"[^"]*"|'[^']*')+?>|[^\2])*?)?\2/g) {  #"
1764                $args{$1} = $3;
1765            }
1766            if ($section) {
1767                if ($close) {
1768                    $mt = pop @cstack;
1769                } else {
1770                    if ($args{component}) {
1771                        push @cstack, $mt;
1772                        $mt = MT->component($args{component})
1773                            or die "Bad translation component: $args{component}";
1774                    }
1775                    else {
1776                        die "__trans_section without a component argument";
1777                    }
1778                }
1779                '';
1780            }
1781            else {
1782                $args{params} = '' unless defined $args{params};
1783                my @p = map MT::Util::decode_html($_),
1784                        split /\s*%%\s*/, $args{params}, -1;
1785                @p = ('') unless @p;
1786                my $translation = $mt->translate($args{phrase}, @p);
1787                if (exists $args{escape}) {
1788                    if (lc($args{escape}) eq 'html') {
1789                        $translation = MT::Util::encode_html($translation);
1790                    } elsif (lc($args{escape}) eq 'url') {
1791                        $translation = MT::Util::encode_url($translation);
1792                    } else {
1793                        # fallback for js/javascript/singlequotes
1794                        $translation = MT::Util::encode_js($translation);
1795                    }
1796                }
1797                $translation;
1798            }
1799            !igem or last;
1800        }
1801        return $text;
1802    }
1803
1804    sub current_language { $LH->language_tag }
1805    sub language_handle  { $LH }
1806
1807    sub charset {
1808        my $mt = shift;
1809        $mt->{charset} = shift if @_;
1810        return $mt->{charset} if $mt->{charset};
1811        $mt->{charset} = $mt->config->PublishCharset
1812          || $mt->language_handle->encoding;
1813    }
1814}
1815
1816sub supported_languages {
1817    my $mt = shift;
1818    require MT::L10N;
1819    require File::Basename;
1820    ## Determine full path to lib/MT/L10N directory...
1821    my $lib =
1822      File::Spec->catdir( File::Basename::dirname( $INC{'MT/L10N.pm'} ),
1823        'L10N' );
1824    ## ... From that, determine full path to extlib/MT/L10N.
1825    ## To do that, we look for the last instance of the string 'lib'
1826    ## in $lib and replace it with 'extlib'. reverse is a nice tricky
1827    ## way of doing that.
1828    ( my $extlib = reverse $lib ) =~ s!bil!biltxe!;
1829    $extlib = reverse $extlib;
1830    my @dirs = ( $lib, $extlib );
1831    my %langs;
1832    for my $dir (@dirs) {
1833        opendir DH, $dir or next;
1834        for my $f ( readdir DH ) {
1835            my ($tag) = $f =~ /^(\w+)\.pm$/;
1836            next unless $tag;
1837            my $lh = MT::L10N->get_handle($tag);
1838            $langs{ $lh->language_tag } = $lh->language_name;
1839        }
1840        closedir DH;
1841    }
1842    \%langs;
1843}
1844
1845# For your convenience
1846sub trans_error {
1847    my $app = shift;
1848    $app->error( $app->translate(@_) );
1849}
1850
1851sub all_text_filters {
1852    unless (%Text_filters) {
1853        if ( my $filters = MT->registry('text_filters') ) {
1854            %Text_filters = %$filters if ref($filters) eq 'HASH';
1855        }
1856    }
1857    if (my $enabled_filters = MT->config('AllowedTextFilters')) {
1858        my %enabled = map { $_ => 1 } split /\s*,\s*/, $enabled_filters;
1859        %Text_filters = map { $_ => $Text_filters{$_} }
1860                        grep { exists $enabled{$_} }
1861                        keys %Text_filters;
1862    }
1863    return \%Text_filters;
1864}
1865
1866sub apply_text_filters {
1867    my $mt = shift;
1868    my ( $str, $filters, @extra ) = @_;
1869    my $all_filters = $mt->all_text_filters;
1870    for my $filter (@$filters) {
1871        my $f = $all_filters->{$filter} or next;
1872        my $code = $f->{code} || $f->{handler};
1873        unless ( ref($code) eq 'CODE' ) {
1874            $code = $mt->handler_to_coderef($code);
1875            $f->{code} = $code;
1876        }
1877        if ( !$code ) {
1878            warn "Bad text filter: $filter";
1879            next;
1880        }
1881        $str = $code->( $str, @extra );
1882    }
1883    return $str;
1884}
1885
1886sub static_path {
1887    my $app = shift;
1888    my $spath = $app->config->StaticWebPath;
1889    if (!$spath) {
1890        $spath = $app->config->CGIPath;
1891        $spath .= '/' unless $spath =~ m!/$!;
1892        $spath .= 'mt-static/';
1893    } else {
1894        $spath .= '/' unless $spath =~ m!/$!;
1895    }
1896    $spath;
1897}
1898
1899sub static_file_path {
1900    my $app = shift;
1901    return $app->{__static_file_path}
1902        if exists $app->{__static_file_path};
1903
1904    my $path = $app->config('StaticFilePath');
1905    return $app->{__static_file_path} = $path if defined $path;
1906
1907    # Attempt to derive StaticFilePath based on environment
1908    my $web_path = $app->config->StaticWebPath || 'mt-static';
1909    $web_path =~ s!^https?://[^/]+/!!;
1910    if ($app->can('document_root')) {
1911        my $doc_static_path = File::Spec->catdir($app->document_root(), $web_path);
1912        return $app->{__static_file_path} = $doc_static_path
1913            if -d $doc_static_path;
1914    }
1915    my $mtdir_static_path = File::Spec->catdir($app->mt_dir, 'mt-static');
1916    return $app->{__static_file_path} = $mtdir_static_path
1917        if -d $mtdir_static_path;
1918    return;
1919}
1920
1921sub template_paths {
1922    my $mt = shift;
1923    my @paths;
1924    my $path = $mt->config->TemplatePath;
1925    if ($mt->{plugin_template_path}) {
1926        if (File::Spec->file_name_is_absolute($mt->{plugin_template_path})) {
1927            push @paths, $mt->{plugin_template_path}
1928                if -d $mt->{plugin_template_path};
1929        } else {
1930            my $dir = File::Spec->catdir($mt->app_dir,
1931                                         $mt->{plugin_template_path});
1932            if (-d $dir) {
1933                push @paths, $dir;
1934            } else {
1935                $dir = File::Spec->catdir($mt->mt_dir,
1936                                          $mt->{plugin_template_path});
1937                push @paths, $dir if -d $dir;
1938            }
1939        }
1940    }
1941    if (my $alt_path = $mt->config->AltTemplatePath) {
1942        if (-d $alt_path) {    # AltTemplatePath is absolute
1943            push @paths, File::Spec->catdir($alt_path,
1944                                            $mt->{template_dir})
1945                if $mt->{template_dir};
1946            push @paths, $alt_path;
1947        }
1948    }
1949 
1950    for my $addon ( @{ $mt->find_addons('pack') } ) {
1951        push @paths, File::Spec->catdir($addon->{path}, 'tmpl', $mt->{template_dir})
1952            if $mt->{template_dir};
1953        push @paths, File::Spec->catdir($addon->{path}, 'tmpl');
1954    }
1955
1956    push @paths, File::Spec->catdir($path, $mt->{template_dir})
1957        if $mt->{template_dir};
1958    push @paths, $path;
1959 
1960    return @paths;
1961}
1962
1963sub find_file {
1964    my $mt = shift;
1965    my ($paths, $file) = @_;
1966    my $filename;
1967    foreach my $p (@$paths) {
1968        my $filepath = File::Spec->canonpath(File::Spec->catfile($p, $file));
1969        $filename = File::Spec->canonpath($filepath);
1970        return $filename if -f $filename;
1971    }
1972    undef;
1973}
1974
1975sub load_tmpl {
1976    my $mt = shift;
1977    if ($mt->{component}) {
1978        if (my $c = $mt->component($mt->{component})) {
1979            return $c->load_tmpl(@_);
1980        }
1981    }
1982
1983    my($file, @p) = @_;
1984    my $param;
1985    if (@p && (ref($p[$#p]) eq 'HASH')) {
1986        $param = pop @p;
1987    }
1988    my $cfg = $mt->config;
1989    require MT::Template;
1990    my $tmpl;
1991    my @paths = $mt->template_paths;
1992
1993    my $type = {'SCALAR' => 'scalarref', 'ARRAY' => 'arrayref'}->{ref $file}
1994        || 'filename';
1995    $tmpl = MT::Template->new(
1996        type => $type, source => $file,
1997        path => \@paths,
1998        filter => sub {
1999            my ($str, $fname) = @_;
2000            if ($fname) {
2001                $fname = File::Basename::basename($fname);
2002                $fname =~ s/\.tmpl$//;
2003                $mt->run_callbacks("template_source.$fname", $mt, @_);
2004            } else {
2005                $mt->run_callbacks("template_source", $mt, @_);
2006            }
2007            return $str;
2008        },
2009        @p);
2010    return $mt->error(
2011        $mt->translate("Loading template '[_1]' failed.", $file)) unless $tmpl;
2012    $mt->set_default_tmpl_params($tmpl);
2013    $tmpl->param($param) if $param;
2014    $tmpl;
2015}
2016
2017sub set_default_tmpl_params {
2018    my $mt = shift;
2019    my ($tmpl) = @_;
2020    my $param = {};
2021    $param->{mt_debug} = $MT::DebugMode;
2022    $param->{mt_beta} = 1 if MT->version_id =~ m/^\d+\.\d+(?:a|b|rc)/;
2023    $param->{static_uri} = $mt->static_path;
2024    $param->{mt_version} = MT->version_number;
2025    $param->{mt_version_id} = MT->version_id;
2026    $param->{mt_product_code} = MT->product_code;
2027    $param->{mt_product_name} = $mt->translate(MT->product_name);
2028    $param->{language_tag} = substr($mt->current_language, 0, 2);
2029    $param->{language_encoding} = $mt->charset;
2030    if ($mt->isa('MT::App')) {
2031        if (my $author = $mt->user) {
2032            $param->{author_id} = $author->id;
2033            $param->{author_name} = $author->name;
2034        }
2035        ## We do this in load_tmpl because show_error and login don't call
2036        ## build_page; so we need to set these variables here.
2037        require MT::Auth;
2038        $param->{can_logout} = MT::Auth->can_logout;
2039        $param->{script_url} = $mt->uri;
2040        $param->{mt_url} = $mt->mt_uri;
2041        $param->{script_path} = $mt->path;
2042        $param->{script_full_url} = $mt->base . $mt->uri;
2043        $param->{agent_mozilla} = ( $ENV{HTTP_USER_AGENT} || '' ) =~ /gecko/i;
2044        $param->{agent_ie} = ( $ENV{HTTP_USER_AGENT} || '' ) =~ /\bMSIE\b/;
2045    }
2046    if (!$tmpl->param('template_filename')) {
2047        if (my $fname = $tmpl->{__file}) {
2048            $fname =~ s!\\!/!g;
2049            $fname =~ s/\.tmpl$//;
2050            $param->{template_filename} = $fname;
2051        }
2052    }
2053    $tmpl->param($param);
2054}
2055
2056sub process_mt_template {
2057    my $mt = shift;
2058    my ($body) = @_;
2059    $body =~ s@<(?:_|MT)_ACTION\s+mode="([^"]+)"(?:\s+([^>]*))?>@
2060        my $mode = $1; my %args;
2061        %args = $2 =~ m/\s*(\w+)="([^"]*?)"\s*/g if defined $2; # "
2062        MT::Util::encode_html($mt->uri(mode => $mode, args => \%args));
2063    @geis;
2064    # Strip out placeholder wrappers to facilitate tmpl_* callbacks
2065    $body =~ s/<\/?MT_(\w+):(\w+)>//g;
2066    $body;
2067}
2068
2069sub build_page {
2070    my $mt = shift;
2071    my($file, $param) = @_;
2072    my $tmpl;
2073    my $mode = $mt->mode;
2074    $param->{"mode_$mode"} ||= 1;
2075    $param->{breadcrumbs} = $mt->{breadcrumbs};
2076    if ($param->{breadcrumbs}[-1]) {
2077        $param->{breadcrumbs}[-1]{is_last} = 1;
2078        $param->{page_titles} = [ reverse @{ $mt->{breadcrumbs} } ];
2079    }
2080    pop @{ $param->{page_titles} };
2081    if (my $lang_id = $mt->current_language) {
2082        $param->{local_lang_id} ||= lc $lang_id;
2083    }
2084    $param->{magic_token} = $mt->current_magic if $mt->user;
2085
2086    # List of installed packs in the application footer
2087    my @packs_installed;
2088    my $packs = $mt->find_addons('pack');
2089    if ($packs) {
2090        foreach my $pack (@$packs) {
2091            my $c = $mt->component(lc $pack->{id});
2092            if ($c) {
2093                my $label = $c->label || $pack->{label};
2094                $label = $label->() if ref($label) eq 'CODE';
2095                push @packs_installed, {
2096                    label => $label,
2097                    version => $c->version,
2098                    id => $c->id,
2099                };
2100            }
2101        }
2102    }
2103    @packs_installed = sort { $a->{label} cmp $b->{label} } @packs_installed;
2104    $param->{packs_installed} = \@packs_installed;
2105    $param->{portal_url} = $mt->translate("__PORTAL_URL__");
2106
2107    for my $config_field (keys %{ MT::ConfigMgr->instance->{__var} || {} }) {
2108        $param->{ $config_field . '_readonly' } = 1;
2109    }
2110
2111    my $tmpl_file = '';
2112    if (UNIVERSAL::isa($file, 'MT::Template')) {
2113        $tmpl = $file;
2114        $tmpl_file = (exists $file->{__file}) ? $file->{__file} : '';
2115    } else {
2116        $tmpl = $mt->load_tmpl($file) or return;
2117    }
2118
2119    if (($mode && ($mode !~ m/delete/)) && ($mt->{login_again} ||
2120        ($mt->{requires_login} && !$mt->user))) {
2121        ## If it's a login screen, direct the user to where they were going
2122        ## (query params including mode and all) unless they were logging in,
2123        ## logging out, or deleting something.
2124        my $q = $mt->{query};
2125        if ($mode) {
2126            my @query = map { {name => $_, value => scalar $q->param($_)}; }
2127                grep { ($_ ne 'username') && ($_ ne 'password') && ($_ ne 'submit') && ($mode eq 'logout' ? ($_ ne '__mode') : 1) } $q->param;
2128            $param->{query_params} = \@query;
2129        }
2130        $param->{login_again} = $mt->{login_again};
2131    }
2132
2133    my $blog = $mt->blog;
2134    $tmpl->context()->stash('blog', $blog) if $blog;
2135
2136    $tmpl->param($param) if $param;
2137
2138    if ($tmpl_file) {
2139        $tmpl_file = File::Basename::basename($tmpl_file);
2140        $tmpl_file =~ s/\.tmpl$//;
2141        $tmpl_file = '.' . $tmpl_file;
2142    }
2143    $mt->run_callbacks('template_param' . $tmpl_file, $mt, $tmpl->param, $tmpl);
2144
2145    my $output = $mt->build_page_in_mem($tmpl);
2146    return unless defined $output;
2147
2148    $mt->run_callbacks('template_output' . $tmpl_file, $mt, \$output, $tmpl->param, $tmpl);
2149    return $output;
2150}
2151
2152sub build_page_in_mem {
2153    my $mt = shift;
2154    my($tmpl, $param) = @_;
2155    $tmpl->param($param) if $param;
2156    my $out = $tmpl->output;
2157    return $mt->error($tmpl->errstr) unless defined $out;
2158    return $mt->translate_templatized($mt->process_mt_template($out));
2159}
2160
2161sub new_ua {
2162    my $class = shift;
2163    my ($opt) = @_;
2164    $opt ||= {};
2165    my $lwp_class = 'LWP::UserAgent';
2166    if ($opt->{paranoid}) {
2167        eval { require LWPx::ParanoidAgent; };
2168        $lwp_class = 'LWPx::ParanoidAgent' unless $@;
2169    }
2170    eval "require $lwp_class;";
2171    return undef if $@;
2172    my $cfg = $class->config;
2173    my $max_size = exists $opt->{max_size} ? $opt->{max_size} : 100_000;
2174    my $timeout = exists $opt->{timeout} ? $opt->{timeout} : $cfg->HTTPTimeout || $cfg->PingTimeout;
2175    my $proxy = exists $opt->{proxy} ? $opt->{proxy} : $cfg->HTTPProxy || $cfg->PingProxy;
2176    my $no_proxy = exists $opt->{no_proxy} ? $opt->{no_proxy} : $cfg->HTTPNoProxy || $cfg->PingNoProxy;
2177    my $agent = $opt->{agent} || 'MovableType/' . $MT::VERSION;
2178    my $interface = exists $opt->{interface} ? $opt->{interface} : $cfg->HTTPInterface || $cfg->PingInterface;
2179
2180    if ( my $localaddr = $interface ) {
2181        @LWP::Protocol::http::EXTRA_SOCK_OPTS = (
2182            LocalAddr => $localaddr,
2183            Reuse     => 1
2184        );
2185    }
2186
2187    my $ua = $lwp_class->new;
2188    $ua->max_size($max_size) if (defined $max_size) && $ua->can('max_size');
2189    $ua->agent( $agent );
2190    $ua->timeout( $timeout ) if defined $timeout;
2191    if ( defined $proxy ) {
2192        $ua->proxy( http => $proxy );
2193        my @domains = split( /,\s*/, $no_proxy ) if $no_proxy;
2194        $ua->no_proxy(@domains) if @domains;
2195    }
2196    return $ua;
2197}
2198
2199sub build_email {
2200    my $class = shift;
2201    my ( $file, $param ) = @_;
2202    my $mt = $class->instance;
2203
2204    # basically, try to load from database
2205    my $blog = $param->{blog} || undef;
2206    my $id = $file;
2207    $id =~ s/(\.tmpl|\.mtml)$//;
2208
2209    require MT::Template;
2210    my @tmpl = MT::Template->load(
2211        {
2212            ( $blog ? ( blog_id => [ $blog->id, 0 ] ) : ( blog_id => 0 ) ),
2213            identifier => $id,
2214            type       => 'email',
2215        }
2216    );
2217    my $tmpl =
2218      @tmpl
2219      ? (
2220        scalar @tmpl > 1
2221        ? ( $tmpl[0]->blog_id ? $tmpl[0] : $tmpl[1] )
2222        : $tmpl[0]
2223      )
2224      : undef;
2225
2226    # try to load from file
2227    unless ($tmpl) {
2228        local $mt->{template_dir} = 'email';
2229        $tmpl = $mt->load_tmpl($file);
2230    }
2231    return unless $tmpl;
2232
2233    my $ctx = $tmpl->context;
2234    $ctx->stash( 'blog',   delete $param->{'blog'} )   if $param->{'blog'};
2235    $ctx->stash( 'entry',  delete $param->{'entry'} )  if $param->{'entry'};
2236    $ctx->stash( 'author', delete $param->{'author'} ) if $param->{'author'};
2237    $ctx->stash( 'commenter', delete $param->{'commenter'} )
2238      if $param->{'commenter'};
2239    $ctx->stash( 'comment', delete $param->{'comment'} ) if $param->{'comment'};
2240    $ctx->stash( 'category', delete $param->{'category'} )
2241      if $param->{'category'};
2242    $ctx->stash( 'ping', delete $param->{'ping'} ) if $param->{'ping'};
2243
2244    foreach my $p (%$param) {
2245        if ( ref($p) ) {
2246            $tmpl->param( $p, $param->{$p} );
2247        }
2248    }
2249    return $mt->build_page_in_mem( $tmpl, $param );
2250}
2251
2252sub get_next_sched_post_for_user {
2253    my ( $author_id, @further_blog_ids ) = @_;
2254    require MT::Permission;
2255    my @perms = MT::Permission->load( { author_id => $author_id }, {} );
2256    my @blogs = @further_blog_ids;
2257    for my $perm (@perms) {
2258        next
2259          unless ( $perm->can_edit_config
2260            || $perm->can_publish_post
2261            || $perm->can_edit_all_posts );
2262        push @blogs, $perm->blog_id;
2263    }
2264    my $next_sched_utc = undef;
2265    require MT::Entry;
2266    for my $blog_id (@blogs) {
2267        my $blog           = MT::Blog->load($blog_id);
2268        my $earliest_entry = MT::Entry->load(
2269            {
2270                status  => MT::Entry::FUTURE(),
2271                blog_id => $blog_id
2272            },
2273            { 'sort' => 'created_on' }
2274        );
2275        if ($earliest_entry) {
2276            my $entry_utc =
2277              MT::Util::ts2iso( $blog, $earliest_entry->created_on );
2278            if ( $entry_utc < $next_sched_utc || !defined($next_sched_utc) ) {
2279                $next_sched_utc = $entry_utc;
2280            }
2281        }
2282    }
2283    return $next_sched_utc;
2284}
2285
2286our %Commenter_Auth;
2287
2288sub init_commenter_authenticators {
2289    my $self = shift;
2290    my $auths = $self->registry("commenter_authenticators") || {};
2291    foreach my $auth ( keys %$auths ) {
2292        delete $auths->{$auth}
2293          if exists( $auths->{$auth}->{condition} )
2294          && !( $auths->{$auth}->{condition}->() );
2295    }
2296    %Commenter_Auth = %$auths;
2297    $Commenter_Auth{$_}{key} ||= $_ for keys %Commenter_Auth;
2298}
2299
2300sub commenter_authenticator {
2301    my $self = shift;
2302    my ($key) = @_;
2303    %Commenter_Auth or $self->init_commenter_authenticators();
2304    return $Commenter_Auth{$key};
2305}
2306
2307sub commenter_authenticators {
2308    my $self = shift;
2309    %Commenter_Auth or $self->init_commenter_authenticators();
2310    return values %Commenter_Auth;
2311}
2312
2313sub _commenter_auth_params {
2314    my ( $key, $blog_id, $entry_id, $static ) = @_;
2315    my $params = {
2316        blog_id => $blog_id,
2317        static  => $static,
2318    };
2319    $params->{entry_id} = $entry_id if defined $entry_id;
2320    return $params;
2321}
2322
2323sub _openid_commenter_condition {
2324    eval "require Digest::SHA1;";
2325    return $@ ? 0 : 1;
2326}
2327
2328sub core_commenter_authenticators {
2329    return {
2330        'OpenID' => {
2331            class      => 'MT::Auth::OpenID',
2332            label      => 'OpenID',
2333            login_form => <<OpenID,
2334<form method="post" action="<mt:var name="script_url">">
2335<input type="hidden" name="__mode" value="login_external" />
2336<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2337<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2338<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2339<fieldset>
2340<mtapp:setting
2341    id="openid_display"
2342    label="<__trans phrase="OpenID URL">"
2343    hint="<__trans phrase="Sign in using your OpenID identity.">">
2344<input type="hidden" name="key" value="OpenID" />
2345<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%;" />
2346    <p class="hint"><__trans phrase="OpenID is an open and decentralized single sign-on identity system."></p>
2347</mtapp:setting>
2348
2349<div class="pkg">
2350<div class="left"><input type="submit" name="submit" value="<__trans phrase="Sign In">" /></div>
2351<div class="right"><img src="<mt:var name="static_uri">images/comment/openid_enabled.png" /></div>
2352</div>
2353<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>
2354</fieldset>
2355</form>
2356OpenID
2357            login_form_params => \&_commenter_auth_params,
2358            condition         => \&_openid_commenter_condition,
2359            logo              => 'images/comment/signin_openid.png',
2360            logo_small        => 'images/comment/openid_logo.png',
2361        },
2362        'LiveJournal' => {
2363            class      => 'MT::Auth::LiveJournal',
2364            label      => 'LiveJournal',
2365            login_form => <<LiveJournal,
2366<form method="post" action="<mt:var name="script_url">">
2367<input type="hidden" name="__mode" value="login_external" />
2368<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2369<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2370<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2371<input type="hidden" name="key" value="LiveJournal" />
2372<fieldset>
2373<mtapp:setting
2374    id="livejournal_display"
2375    label="<__trans phrase="Your LiveJournal Username">"
2376    hint="<__trans phrase="Sign in using your Vox blog URL">">
2377<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%;" />
2378</mtapp:setting>
2379<div class="actions-bar actions-bar-login">
2380    <div class="actions-bar-inner pkg actions">
2381        <button
2382            type="submit"
2383            class="primary-button"
2384            ><__trans phrase="Sign in"></button>
2385    </div>
2386</div>
2387<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>
2388</fieldset>
2389</form>
2390LiveJournal
2391            login_form_params => \&_commenter_auth_params,
2392            condition         => \&_openid_commenter_condition,
2393            logo              => 'images/comment/signin_livejournal.png',
2394            logo_small        => 'images/comment/livejournal_logo.png',
2395        },
2396        'Vox' => {
2397            class      => 'MT::Auth::Vox',
2398            label      => 'Vox',
2399            login_form => <<Vox,
2400<form method="post" action="<mt:var name="script_url">">
2401<input type="hidden" name="__mode" value="login_external" />
2402<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2403<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2404<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2405<input type="hidden" name="key" value="Vox" />
2406<fieldset>
2407<mtapp:setting
2408    id="vox_display"
2409    label="<__trans phrase="Your Vox Blog URL">">
2410http:// <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
2411</mtapp:setting>
2412<div class="actions-bar actions-bar-login">
2413    <div class="actions-bar-inner pkg actions">
2414        <button
2415            type="submit"
2416            class="primary-button"
2417            ><__trans phrase="Sign in"></button>
2418    </div>
2419</div>
2420<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>
2421</fieldset>
2422</form>
2423Vox
2424            login_form_params => \&_commenter_auth_params,
2425            condition         => \&_openid_commenter_condition,
2426            logo              => 'images/comment/signin_vox.png',
2427            logo_small        => 'images/comment/vox_logo.png',
2428        },
2429        'TypeKey' => {
2430            class      => 'MT::Auth::TypeKey',
2431            label      => 'TypeKey',
2432            login_form => <<TypeKey,
2433<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>
2434<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>
2435TypeKey
2436            login_form_params => sub {
2437                my ( $key, $blog_id, $entry_id, $static ) = @_;
2438                my $entry = MT::Entry->load($entry_id) if $entry_id;
2439
2440                ## TypeKey URL
2441                require MT::Template::Context;
2442                my $ctx = MT::Template::Context->new;
2443                $ctx->stash( 'blog_id', $blog_id );
2444                my $blog = MT::Blog->load($blog_id);
2445                $ctx->stash( 'blog',  $blog );
2446                $ctx->stash( 'entry', $entry );
2447                my $params = {};
2448                $params->{tk_signin_url} =
2449                  MT::Template::Context::_hdlr_remote_sign_in_link( $ctx,
2450                    { static => $static } );
2451                return $params;
2452            },
2453            logo => 'images/comment/signin_typekey.png',
2454            logo_small        => 'images/comment/typekey_logo.png',
2455        },
2456    };
2457}
2458
2459our %Captcha_Providers;
2460
2461sub captcha_provider {
2462    my $self = shift;
2463    my ($key) = @_;
2464    $self->init_captcha_providers() unless %Captcha_Providers;
2465    return $Captcha_Providers{$key};
2466}
2467
2468sub captcha_providers {
2469    my $self = shift;
2470    $self->init_captcha_providers() unless %Captcha_Providers;
2471    my $def  = delete $Captcha_Providers{'mt_default'};
2472    my @vals = values %Captcha_Providers;
2473    if ( defined($def) && $def->{condition}->() ) {
2474        unshift @vals, $def;
2475    }
2476    @vals;
2477}
2478
2479sub core_captcha_providers {
2480    return {
2481        'mt_default' => {
2482            label     => 'Movable Type default',
2483            class     => 'MT::Util::Captcha',
2484            condition => sub {
2485                require MT::Util::Captcha;
2486                if ( my $error = MT::Util::Captcha->check_availability ) {
2487                    return 0;
2488                }
2489                1;
2490            },
2491        }
2492    };
2493}
2494
2495sub init_captcha_providers {
2496    my $self = shift;
2497    my $providers = $self->registry("captcha_providers") || {};
2498    foreach my $provider ( keys %$providers ) {
2499        delete $providers->{$provider}
2500          if exists( $providers->{$provider}->{condition} )
2501          && !( $providers->{$provider}->{condition}->() );
2502    }
2503    %Captcha_Providers = %$providers;
2504    $Captcha_Providers{$_}{key} ||= $_ for keys %Captcha_Providers;
2505}
2506
2507sub effective_captcha_provider {
2508    my $class = shift;
2509    my ($key) = @_;
2510    return undef unless $key;
2511    my $cp = $class->captcha_provider($key) or return;
2512    if ( exists $cp->{condition} ) {
2513        return undef unless $cp->{condition}->();
2514    }
2515    my $pkg = $cp->{class};
2516    $pkg =~ s/;//g;
2517    eval "require $pkg" or return;
2518    return $cp->{class};
2519}
2520
2521sub handler_to_coderef {
2522    my $pkg = shift;
2523    my ( $name, $delayed ) = @_;
2524
2525    return $name if ref($name) eq 'CODE';
2526    return undef unless defined $name && $name ne '';
2527
2528    my $code;
2529    if ( $name !~ m/->/ ) {
2530
2531        # check for Package::Routine first; if defined, return coderef
2532        no strict 'refs';
2533        $code = \&$name if defined &$name;
2534        return $code if $code;
2535    }
2536
2537    my $component;
2538    if ( $name =~ m!^\$! ) {
2539        if ( $name =~ s/^\$(\w+)::// ) {
2540            $component = $1;
2541        }
2542    }
2543    if ( $name =~ m/^\s*sub\s*\{/s ) {
2544        $code = eval $name or die $@;
2545
2546        if ($component) {
2547            return sub {
2548                my $mt_inst = MT->instance;
2549                local $mt_inst->{component} = $component;
2550                $code->(@_);
2551            };
2552        }
2553        else {
2554            return $code;
2555        }
2556    }
2557
2558    my $hdlr_pkg = $name;
2559    my $method;
2560    if ( $hdlr_pkg =~ s/(->|::)([^:]+)$// ) {    # strip routine name
2561        $method = $2 if $1 eq '->';
2562    }
2563    if ( !defined(&$name) && !$pkg->can( 'AUTOLOAD' ) ) {
2564
2565        # The delayed option will return a coderef that delays the loading
2566        # of the package holding the handler routine.
2567        if ($delayed) {
2568            if ($method) {
2569                return sub {
2570                    eval "require $hdlr_pkg;"
2571                      or Carp::confess(
2572                        "failed loading package $hdlr_pkg for routine $name: $@");
2573                    my $mt_inst = MT->instance;
2574                    local $mt_inst->{component} = $component
2575                      if $component;
2576                    return $hdlr_pkg->$method(@_);
2577                };
2578            }
2579            else {
2580                return sub {
2581                    eval "require $hdlr_pkg;"
2582                      or Carp::confess(
2583                        "failed loading package $hdlr_pkg for routine $name: $@");
2584                    my $mt_inst = MT->instance;
2585                    local $mt_inst->{component} = $component
2586                      if $component;
2587                    no strict 'refs';
2588                    my $hdlr = \&$name;
2589                    use strict 'refs';
2590                    return $hdlr->(@_);
2591                };
2592            }
2593        }
2594        else {
2595            eval "require $hdlr_pkg;"
2596              or Carp::confess(
2597                "failed loading package $hdlr_pkg for routine $name: $@");
2598        }
2599    }
2600    if ($method) {
2601        $code = sub {
2602            my $mt_inst = MT->instance;
2603            local $mt_inst->{component} = $component
2604              if $component;
2605            return $hdlr_pkg->$method(@_);
2606        };
2607    }
2608    else {
2609        if ($component) {
2610            $code = sub {
2611                no strict 'refs';
2612                my $hdlr = (
2613                    defined &$name ? \&$name
2614                    : ( $pkg->can( 'AUTOLOAD' ) ? \&$name
2615                        : undef )
2616                );
2617                use strict 'refs';
2618                if ($hdlr) {
2619                    my $mt_inst = MT->instance;
2620                    local $mt_inst->{component} = $component
2621                      if $component;
2622                    return $hdlr->(@_);
2623                }
2624                return undef;
2625              }
2626        }
2627        else {
2628            no strict 'refs';
2629            $code =
2630              (
2631                defined &$name
2632                ? \&$name
2633                : ( $hdlr_pkg->can( 'AUTOLOAD' ) ? \&$name : undef )
2634              );
2635        }
2636    }
2637    return $code;
2638}
2639
2640sub help_url {
2641    my $pkg = shift;
2642    my ( $append ) = @_;
2643
2644    my $url = $pkg->config->HelpURL;
2645    return $url if defined $url;
2646    $url = $pkg->translate('http://www.movabletype.org/documentation/');
2647    if ( $append ) {
2648        $url .= $append;
2649    }
2650    $url;
2651}
2652
26531;
2654
2655__END__
2656
2657=head1 NAME
2658
2659MT - Movable Type
2660
2661=head1 SYNOPSIS
2662
2663    use MT;
2664    my $mt = MT->new;
2665    $mt->rebuild(BlogID => 1)
2666        or die $mt->errstr;
2667
2668=head1 DESCRIPTION
2669
2670The I<MT> class is the main high-level rebuilding/pinging interface in the
2671Movable Type library. It handles all rebuilding operations. It does B<not>
2672handle any of the application functionality--for that, look to I<MT::App> and
2673I<MT::App::CMS>, both of which subclass I<MT> to handle application requests.
2674
2675=head1 PLUGIN APPLICATIONS
2676
2677At any given time, the user of the Movable Type platform is
2678interacting with either the core Movable Type application, or a plugin
2679application (or "sub-application").
2680
2681A plugin application is a plugin with a user interface that inherits
2682functionality from Movable Type, and appears to the user as a
2683component of Movable Type. A plugin application typically has its own
2684templates displaying its own special features; but it inherits some
2685templates from Movable Type, such as the navigation chrome and error
2686pages.
2687
2688=head2 The MT Root and the Application Root
2689
2690To locate assets of the core Movable Type application and any plugin
2691applications, the platform uses two directory paths, C<mt_dir> and
2692C<app_dir>. These paths are returned by the MT class methods with the
2693same names, and some other methods return derivatives of these paths.
2694
2695Conceptually, mt_dir is the root of the Movable Type installation, and
2696app_dir is the root of the "currently running application", which
2697might be Movable Type or a plugin application. It is important to
2698understand the distinction between these two values and what each is
2699used for.
2700
2701The I<mt_dir> is the absolute path to the directory where MT itself is
2702located. Most importantly, the MT configuration file and the CGI scripts that
2703bootstrap an MT request are found here. This directory is also the
2704default base path under which MT's core templates are found (but this
2705can be overridden using the I<TemplatePath> configuration setting).
2706
2707Likewise, the I<app_dir> is the directory where the "current"
2708application's assets are rooted. The platform will search for
2709application templates underneath the I<app_dir>, but this search also
2710searches underneath the I<mt_dir>, allowing the application to make
2711use of core headers, footers, error pages, and possibly other
2712templates.
2713
2714In order for this to be useful, the plugin's templates and
2715code should all be located underneath the same directory. The relative
2716path from the I<app_dir> to the application's templates is
2717configurable. For details on how to indicate the location of your
2718plugin's templates, see L<MT::App>.
2719
2720=head2 Finding the Root Paths
2721
2722When a plugin application initializes its own application class (a
2723subclass of MT::App), the I<mt_dir> should be discovered and passed
2724constructor. This comes either from the C<Directory> parameter or the
2725C<Config> parameter.
2726
2727Since plugins are loaded from a descendent of the MT root directory,
2728the plugin bootstrap code can discover the MT configuration file (and thus
2729the MT root directory) by traversing the filesystem; the absolute path
2730to that file can be passed as the C<Config> parameter to
2731MT::App::new. Working code to do this can be found in the
2732examples/plugins/mirror/mt-mirror.cgi file.
2733
2734The I<app_dir>, on the other hand, always derives from the location of
2735the currently-running program, so it typically does not need to be
2736specified.
2737
2738=head1 USAGE
2739
2740I<MT> has the following interface. On failure, all methods return C<undef>
2741and set the I<errstr> for the object or class (depending on whether the
2742method is an object or class method, respectively); look below at the section
2743L<ERROR HANDLING> for more information.
2744
2745=head2 MT->new( %args )
2746
2747Constructs a new I<MT> instance and returns that object. Returns C<undef>
2748on failure.
2749
2750I<new> will also read your MT configuration file (provided that it can find it--if
2751you find that it can't, take a look at the I<Config> directive, below). It
2752will also initialize the chosen object driver; the default is the C<DBM>
2753object driver.
2754
2755I<%args> can contain:
2756
2757=over 4
2758
2759=item * Config
2760
2761Path to the MT configuration file.
2762
2763If you do not specify a path, I<MT> will try to find your MT configuration file
2764in the current working directory.
2765
2766=item * Directory
2767
2768Path to the MT home directory.
2769
2770If you do not specify a path, I<MT> will try to find the MT directory using
2771the discovered path of the MT configuration file.
2772
2773=back
2774
2775=head2 $mt->init
2776
2777Initializes the Movable Type instance, including registration of basic
2778resources and callbacks. This method also invokes the C<init_config>
2779and C<init_plugins> methods.
2780
2781=head2 MT->instance
2782
2783MT and all it's subclasses are now singleton classes, meaning you can only
2784have one instance per package. MT->instance() returns the active instance.
2785MT->new() is now an alias to instance_of.
2786
2787=head2 $class->instance_of
2788
2789Returns the singleton instance of the MT subclass identified by C<$class>.
2790
2791=head2 $class->construct
2792
2793Constructs a new instance of the MT subclass identified by C<$class>.
2794
2795=head2 MT->set_instance
2796
2797Assigns the active MT instance object. This value is returned when
2798C<MT-E<gt>instance> is invoked.
2799
2800=head2 $mt->find_config($params)
2801
2802Handles the discovery of the MT configuration file. The path and filename
2803for the configuration file is returned as the result. The C<$params>
2804parameter is a reference to the hash of settings passed to the MT
2805constructor.
2806
2807=head2 $mt->init_config($params)
2808
2809Reads the MT configuration settingss from the MT configuration file
2810and settings from database (L<MT::Config>).
2811
2812The C<$params> parameter is a reference to the hash of settings passed to
2813the MT constructor.
2814
2815=head2 $mt->init_plugins
2816
2817Loads any discoverable plugins that are available. This is called from
2818the C<init> method, after the C<init_config> method has loaded the
2819configuration settings.
2820
2821=head2 $mt->init_tasks
2822
2823Registers the standard set of periodic tasks that Movable Type provides
2824and then invokes the C<init_tasks> method for each available plugin.
2825
2826=head2 MT->run_tasks
2827
2828Initializes the tasks, running C<init_tasks> and invokes the task system
2829through L<MT::TaskMgr> to run any registered tasks that are pending
2830execution. See L<MT::TaskMgr> for further documentation.
2831
2832=head2 MT->unplug
2833
2834Removes the global reference to the MT instance.
2835
2836=head2 MT::log( $message ) or $mt->log( $message )
2837
2838Adds an entry to the application's log table. Also writes message to
2839STDERR which is typically routed to the web server's error log.
2840
2841=head2 $mt->server_path, $mt->mt_dir
2842
2843Both of these methods return the physical file path to the directory
2844that is the home of the MT installation. This would be the value of
2845the 'Directory' parameter given in the MT constructor, or would be
2846determined based on the path of the configuration file.
2847
2848=head2 $mt->app_dir
2849
2850Returns the physical file path to the active application directory. This
2851is determined by the directory of the active script.
2852
2853=head2 $mt->config_dir
2854
2855Returns the path to the MT configuration file.
2856
2857=head2 $mt->config([$setting[, $value]])
2858
2859This method is used to get and set configuration settings. When called
2860without any parameters, it returns the active MT::ConfigMgr instance
2861used by the application.
2862
2863Specifying the C<$setting> parameter will return the value for that setting.
2864When passing the C<$value> parameter, this will update the config object,
2865assigning that value for the named C<$setting>.
2866
2867=head2 $mt->user_class
2868
2869Returns the package name for the class used for user authentication.
2870This is typically L<MT::Author>.
2871
2872=head2 $mt->request([$element[,$data]])
2873
2874The request method provides a request-scoped storage object. It is an
2875access interface for the L<MT::Request> package. Calling without any
2876parameters will return the L<MT::Request> instance.
2877
2878When called with the C<$element> parameter, the data stored for that
2879element is returned (or undef, if it didn't exist). When called with
2880the C<$data> parameter, it will store the data into the specified
2881element in the request object.
2882
2883All values placed in the request object are lost at the end of the
2884request. If the running application is not a web-based application,
2885the request object exists for the lifetime of the process and is
2886released when the process ends.
2887
2888See the L<MT::Request> package for more information.
2889
2890=head2 MT->new_ua
2891
2892Returns a new L<LWP::UserAgent> instance that is configured according to the
2893Movable Type configuration settings (specifically C<HTTPInterface>, C<HTTPTimeout>, C<HTTPProxy> and C<HTTPNoProxy>). The agent string is set
2894to "MovableType/(version)" and is also limited to receiving a response of
2895100,000 bytes by default (you can override this by using the 'max_size'
2896method on the returned instance). Using this method is recommended for
2897any HTTP requests issued by Movable Type since it uses the MT configuration
2898settings to prepare the UserAgent object.
2899
2900=head2 $mt->ping( %args )
2901
2902Sends all configured XML-RPC pings as a way of notifying other community
2903sites that your blog has been updated.
2904
2905I<%args> can contain:
2906
2907=over 4
2908
2909=item * Blog
2910
2911An I<MT::Blog> object corresponding to the blog for which you would like to
2912send the pings.
2913
2914Either this or C<BlogID> is required.
2915
2916=item * BlogID
2917
2918The ID of the blog for which you would like to send the pings.
2919
2920Either this or C<Blog> is required.
2921
2922=back
2923
2924=head2 $mt->ping_and_save( %args )
2925
2926Handles the task of issuing any pending ping operations for a given
2927entry and then saving that entry back to the database.
2928
2929The I<%args> hash should contain an element named C<Entry> that is a
2930reference to a L<MT::Entry> object.
2931
2932=head2 $mt->needs_ping(%param)
2933
2934Returns a list of URLs that have not been pinged for a given entry. Named
2935parameters for this method are:
2936
2937=over 4
2938
2939=item Entry
2940
2941The L<MT::Entry> object to examine.
2942
2943=item Blog
2944
2945The L<MT::Blog> object that is the parent of the entry given.
2946
2947=back
2948
2949The return value is an array reference of URLs that have not been pinged
2950for the given entry.
2951
2952An empty list is returned for entries that have a non 'RELEASE' status.
2953
2954=head2 $mt->update_ping_list($blog)
2955
2956Returns a list of URLs for ping services that have been configured to
2957be notified when posting new entries.
2958
2959=head2 $mt->set_language($tag)
2960
2961Loads the localization plugin for the language specified by I<$tag>, which
2962should be a valid and supported language tag--see I<supported_languages> to
2963obtain a list of supported languages.
2964
2965The language is set on a global level, and affects error messages and all
2966text in the administration system.
2967
2968This method can be called as either a class method or an object method; in
2969other words,
2970
2971    MT->set_language($tag)
2972
2973will also work. However, the setting will still be global--it will not be
2974specified to the I<$mt> object.
2975
2976The default setting--set when I<MT::new> is called--is U.S. English. If a
2977I<DefaultLanguage> is set in the MT configuration file, the default is then
2978set to that language.
2979
2980=head2 MT->translate($str[, $param, ...])
2981
2982Translates I<$str> into the currently-set language (set by I<set_language>),
2983and returns the translated string. Any parameters following I<$str> are
2984passed through to the C<maketext> method of the active localization module.
2985
2986=head2 MT->translate_templatized($str)
2987
2988Translates a string that has embedded E<lt>MT_TRANSE<gt> tags. These
2989tags identify the portions of the string that require localization.
2990Each tag is processed separately and passed through the MT->translate
2991method. Examples (used in your application's HTML::Template templates):
2992
2993    <p><MT_TRANS phrase="Hello, world"></p>
2994
2995and
2996
2997    <p><MT_TRANS phrase="Hello, [_1]" params="<TMPL_VAR NAME=NAME>"></p>
2998
2999=head2 $mt->trans_error( $str[, $arg1, $arg2] )
3000
3001Translates I<$str> into the currently-set language (set by I<set_language>),
3002and assigns it as the active error for the MT instance. It returns undef,
3003which is the usual return value upon generating an error in the application.
3004So when an error occurs, the typical return result would be:
3005
3006    if ($@) {
3007        return $app->trans_error("An error occurred: [_1]", $@);
3008    }
3009
3010The optional I<$arg1> (and so forth) parameters are passed as parameters to
3011any parameterized error message.
3012
3013=head2 $mt->current_language
3014
3015Returns the language tag for the currently-set language.
3016
3017=head2 MT->supported_languages
3018
3019Returns a reference to an associative array mapping language tags to their
3020proper names. For example:
3021
3022    use MT;
3023    my $langs = MT->supported_languages;
3024    print map { $_ . " => " . $langs->{$_} . "\n" } keys %$langs;
3025
3026=head2 MT->language_handle
3027
3028Returns the active MT::L10N language instance for the active language.
3029
3030=head2 MT->add_plugin($plugin)
3031
3032Adds the plugin described by $plugin to the list of plugins displayed
3033on the welcome page. The argument should be an object of the
3034I<MT::Plugin> class.
3035
3036=head2 MT->all_text_filters
3037
3038Returns a reference to a hash containing the registry of text filters.
3039
3040=head2 MT->apply_text_filters($str, \@filters)
3041
3042Applies the set of filters I<\@filters> to the string I<$str> and returns
3043the result (the filtered string).
3044
3045I<\@filters> should be a reference to an array of filter keynames--these
3046are the short names passed in as the first argument to I<add_text_filter>.
3047I<$str> should be a scalar string to be filtered.
3048
3049If one of the filters listed in I<\@filters> is not found in the list of
3050registered filters (that is, filters added through I<add_text_filter>),
3051it will be skipped silently. Filters are executed in the order in which they
3052appear in I<\@filters>.
3053
3054As it turns out, the I<MT::Entry::text_filters> method returns a reference
3055to the list of text filters to be used for that entry. So, for example, to
3056use this method to apply filters to the main entry text for an entry
3057I<$entry>, you would use
3058
3059    my $out = MT->apply_text_filters($entry->text, $entry->text_filters);
3060
3061=head2 MT->add_callback($meth, $priority, $plugin, $code)
3062
3063Registers a new callback handler for a particular registered callback.
3064
3065The first parameter is the name of the callback method. The second
3066parameter is a priority (a number in the range of 1-10) which will control
3067the order that the handler is executed in relation to other handlers. If
3068two handlers register with the same priority, they will be executed in
3069the order that they registered. The third parameter is a C<MT::Plugin> object
3070reference that is associated with the handler (this parameter is optional).
3071The fourth parameter is a code reference that is invoked to handle the
3072callback. For example:
3073
3074    MT->add_callback('BuildFile', 1, undef, \&rebuild_file_hdlr);
3075
3076The code reference should expect to receive an object of type
3077L<MT::Callback> as its first argument. This object is used to
3078communicate errors to the caller:
3079
3080    sub rebuild_file_hdlr {
3081        my ($cb, ...) = @_;
3082        if (something bad happens) {
3083            return $cb->error("Something bad happened!");
3084        }
3085    }
3086
3087Other parameters to the callback function depend on the callback point.
3088
3089The treatment of the error string depends on the callback point.
3090Typically, either it is ignored or the user's action fails and the
3091error message is displayed.
3092
3093The value returned from this method is the new L<MT::Callback> object.
3094
3095=head2 MT->remove_callback($callback)
3096
3097Removes a callback that was previously registered.
3098
3099=head2 MT->register_callbacks([...])
3100
3101Registers several callbacks simultaneously. Each element in the array
3102parameter given should be a hashref containing these elements: C<name>,
3103C<priority>, C<plugin> and C<code>.
3104
3105=head2 MT->run_callbacks($meth[, $arg1, $arg2, ...])
3106
3107Invokes a particular callback, running any associated callback handlers.
3108
3109The first parameter is the name of the callback to execute. This is one
3110of the global callback methods (see L<Callbacks> section) or can be
3111a class-specific method that includes the package name associated with
3112the callback.
3113
3114The remaining arguments are passed through to any callback handlers that
3115are invoked.
3116
3117For "Filter"-type callbacks, this routine will return a 0 if any of the
3118handlers return a false result. If all handlers return a true result,
3119a value of 1 is returned.
3120
3121Example:
3122
3123    MT->run_callbacks('MyClass::frobnitzes', \@whirlygigs);
3124
3125Which would execute any handlers that registered in this fashion:
3126
3127    MT->add_callback('MyClass::frobnitzes', 4, $plugin, \&frobnitz_hdlr);
3128
3129=head2 MT->run_callback($cb[, $arg1, $arg2, ...])
3130
3131An internal routine used by C<run_callbacks> to invoke a single
3132L<MT::Callback>.
3133
3134=head2 callback_error($str)
3135
3136This routine is used internally by C<MT::Callback> to set any error response
3137that comes from invoking a callback.
3138
3139=head2 callback_errstr
3140
3141This internal routine returns the error response stored using the
3142C<callback_error> routine.
3143
3144=head2 MT->product_code
3145
3146The product code identifying the Movable Type product that is installed.
3147This is either 'MTE' for Movable Type Enterprise or 'MT' for the
3148non-Enterprise product.
3149
3150=head2 MT->product_name
3151
3152The name of the Movable Type product that is installed. This is either
3153'Movable Type Enterprise' or 'Movable Type Publishing Platform'.
3154
3155=head2 MT->product_version
3156
3157The version number of the product. This is different from the C<version_id>
3158and C<version_number> methods as they report the API version information.
3159
3160=head2 MT->version_id
3161
3162Returns the API version of MT (including any beta/alpha designations).
3163
3164=head2 MT->version_number
3165
3166Returns the numeric API version of MT (without any beta/alpha designations).
3167For example, if I<version_id> returned C<2.5b1>, I<version_number> would
3168return C<2.5>.
3169
3170=head2 MT->schema_version
3171
3172Returns the version of the MT database schema.
3173
3174=head2 MT->version_slug
3175
3176Returns a string of text that is appended to emails sent through the
3177C<build_email> method.
3178
3179=head2 $mt->publisher
3180
3181Returns the L<MT::WeblogPublisher> object that is used for managing the
3182MT publishing process. See L<MT::WeblogPublisher> for more information.
3183
3184=head2 $mt->rebuild
3185
3186An alias to L<MT::WeblogPublisher::rebuild>. See L<MT::WeblogPublisher>
3187for documentation of this method.
3188
3189=head2 $mt->rebuild_entry
3190
3191An alias to L<MT::WeblogPublisher::rebuild_entry>. See L<MT::WeblogPublisher>
3192for documentation of this method.
3193
3194=head2 $mt->rebuild_indexes
3195
3196An alias to L<MT::WeblogPublisher::rebuild_indexes>. See
3197L<MT::WeblogPublisher> for documentation of this method.
3198
3199=head2 $mt->build_email($file, $param)
3200
3201Loads a template from the application's 'email' template directory and
3202processes it as a HTML::Template. The C<$param> argument is a hash reference
3203of parameter data for the template. The return value is the output of the
3204template.
3205
3206=head2 MT::get_next_sched_post_for_user($author_id, @blog_ids)
3207
3208This is an internal routine used by L<MT::XMLRPCServer> and the
3209getNextScheduled XMLRPC method to determine the timestamp for the next
3210entry that is scheduled for publishing. The return value is the timestamp
3211in UTC time in the format "YYYY-MM-DDTHH:MM:SSZ".
3212
3213=head1 ERROR HANDLING
3214
3215On an error, all of the above methods return C<undef>, and the error message
3216can be obtained by calling the method I<errstr> on the class or the object
3217(depending on whether the method called was a class method or an instance
3218method).
3219
3220For example, called on a class name:
3221
3222    my $mt = MT->new or die MT->errstr;
3223
3224Or, called on an object:
3225
3226    $mt->rebuild(BlogID => $blog_id)
3227        or die $mt->errstr;
3228
3229=head1 DEBUGGING
3230
3231MT has a package variable C<$MT::DebugMode> which is assigned through
3232your MT configuration file (DebugMode setting). If this is set to
3233any non-zero value, MT applications will display any C<warn>'d
3234statements to a panel that is displayed within the app.
3235
3236The DebugMode is a bit-wise setting and offers the following options:
3237
3238    1 - Display debug messages
3239    2 - Display a stack trace for messages captured
3240    4 - Lists queries issued by Data::ObjectDriver
3241    8 - Reports on MT templates that take more than 1/4 second to build*
3242    128 - Outputs app-level request/response information to STDERR.
3243
3244These can be combined, so if you want to display queries and debug messages,
3245use a DebugMode of 5 for instance.
3246
3247You may also use the local statement to temporarily apply a particular bit,
3248if you want to scope the debug messages you receive to a block of code:
3249
3250    local $MT::DebugMode |= 4;  # show me the queries for the following
3251    my $obj = MT::Entry->load({....});
3252
3253*DebugMode bit 8 actually outputs it's messages to STDERR (which typically
3254is sent to your web server's error log).
3255
3256=head1 CALLBACKS
3257
3258Movable Type has a variety of hook points at which a plugin can attach
3259a callback.
3260
3261In each case, the first parameter is an L<MT::Callback> object which
3262can be used to pass error information back to the caller.
3263
3264The app-level callbacks related to rebuilding are documented
3265in L<MT::WeblogPublisher>. The specific apps document the callbacks
3266which they invoke.
3267
3268=head2 NewUserProvisioning($cb, $user)
3269
3270This callback is invoked when a user is being added to Movable Type.
3271Movable Type itself registers for this callback (with a priority of 5)
3272to provision the user with a new weblog if the system has been configured
3273to do so.
3274
3275=head1 LICENSE
3276
3277The license that applies is the one you agreed to when downloading
3278Movable Type.
3279
3280=head1 AUTHOR & COPYRIGHT
3281
3282Except where otherwise noted, MT is Copyright 2001-2008 Six Apart.
3283All rights reserved.
3284
3285=cut
Note: See TracBrowser for help on using the browser.