root/trunk/lib/MT.pm @ 3581

Revision 3581, 132.3 kB (checked in by fumiakiy, 8 months ago)

Bumping up numbers to match the current state.
Line 
1# Movable Type (r) Open Source (C) 2001-2009 Six Apart, Ltd.
2# This program is distributed under the terms of the
3# GNU General Public License, version 2.
4#
5# $Id: MT.pm.pre 2276 2008-05-08 16:52:18Z fumiakiy $
6
7package MT;
8
9use strict;
10use base qw( MT::ErrorHandler );
11use File::Spec;
12use File::Basename;
13use MT::Util qw( weaken );
14use MT::I18N qw( encode_text );
15
16our ( $VERSION,      $SCHEMA_VERSION );
17our ( $PRODUCT_NAME, $PRODUCT_CODE, $PRODUCT_VERSION, $VERSION_ID, $PORTAL_URL );
18our ( $MT_DIR,       $APP_DIR, $CFG_DIR, $CFG_FILE, $SCRIPT_SUFFIX );
19our (
20    $plugin_sig, $plugin_envelope, $plugin_registry,
21    %Plugins,    @Components,      %Components,
22    $DebugMode,  $mt_inst,         %mt_inst
23);
24my %Text_filters;
25
26# For state determination in MT::Object
27our $plugins_installed;
28
29BEGIN {
30    $plugins_installed = 0;
31
32    ( $VERSION, $SCHEMA_VERSION ) = ( '4.25', '4.0070' );
33    ( $PRODUCT_NAME, $PRODUCT_CODE, $PRODUCT_VERSION, $VERSION_ID, $PORTAL_URL ) = (
34        '__PRODUCT_NAME__', 'MT',
35        '4.25', '4.25',
36        '__PORTAL_URL__'
37    );
38
39    # To allow MT to run straight from svn, if no build process (pre-processing)
40    # is run, then default to MTOS
41    if ($PRODUCT_NAME eq '__PRODUCT' . '_NAME__') {
42        $PRODUCT_NAME = 'Movable Type';
43    }
44    if ($PORTAL_URL eq '__PORTAL' . '_URL__') {
45        $PORTAL_URL = 'http://www.movabletype.org/';
46    }
47
48    $DebugMode = 0;
49
50    # Alias lowercase to uppercase package; note: this is an equivalence
51    # as opposed to having @mt::ISA set to 'MT'. so @mt::Plugins would
52    # resolve as well as @MT::Plugins.
53    *{mt::} = *{MT::};
54
55    # Alias these; Components is the preferred array for MT 4
56    *Plugins = \@Components;
57}
58
59# On-demand loading of compatibility module, if a plugin asks for it, using
60#     use MT 3;
61# or even specific to minor version (but this just loads MT::Compat::v3)
62#     use MT 3.3;
63sub VERSION {
64    my $v = $_[1];
65    if ( defined $v && ( $v =~ m/^(\d+)/ ) ) {
66        my $compat = "MT::Compat::v" . $1;
67        if ( ( $1 > 2 ) && ( $1 < int($VERSION) ) ) {
68            no strict 'refs';
69            unless ( defined *{ $compat . '::' } ) {
70                eval "# line " . __LINE__ . " " . __FILE__ . "\nrequire $compat;";
71            }
72        }
73    }
74    return UNIVERSAL::VERSION(@_);
75}
76
77sub version_number  { $VERSION }
78sub version_id      { $VERSION_ID }
79sub product_code    { $PRODUCT_CODE }
80sub product_name    { $PRODUCT_NAME }
81sub product_version { $PRODUCT_VERSION }
82sub schema_version  { $SCHEMA_VERSION }
83sub portal_url      {
84    require MT::I18N;
85    if ( my $url = MT::I18N::const('PORTAL_URL') ) {
86        return $url;
87    }
88    return $PORTAL_URL;
89}
90
91# Default id method turns MT::App::CMS => cms; Foo::Bar => foo/bar
92sub id {
93    my $pkg = shift;
94    my $id = ref($pkg) || $pkg;
95    # ignore the MT::App prefix as part of the identifier
96    $id =~ s/^MT::App:://;
97    $id =~ s!::!/!g;
98    return lc $id;
99}
100
101sub version_slug {
102    return MT->translate_templatized(<<"SLUG");
103<__trans phrase="Powered by [_1]" params="$PRODUCT_NAME">
104<__trans phrase="Version [_1]" params="$VERSION_ID">
105<__trans phrase="http://www.sixapart.com/movabletype/">
106SLUG
107}
108
109sub build_id {
110    my $build_id = '__BUILD_ID__';
111    $build_id = '' if $build_id eq '__BUILD_' . 'ID__';
112    return $build_id;
113}
114
115sub import {
116    my $pkg = shift;
117    return unless @_;
118
119    my (%param) = @_;
120    my $app_pkg;
121    if ( $app_pkg = $param{app} || $param{App} || $ENV{MT_APP} ) {
122        if ( $app_pkg !~ m/::/ ) {
123            my $apps = $pkg->registry('applications');
124            $app_pkg = $apps->fetch($app_pkg);
125            if ( ref $app_pkg ) {
126
127                # pick first one??
128                $app_pkg = $app_pkg->[0];
129
130                # pick last one??
131                # $app_pkg = pop @$app_pkg;
132            }
133        }
134    }
135    elsif ( $param{run} || $param{Run} ) {
136
137        # my $script = File::Spec->rel2abs($0);
138        my ( $filename, $path, $suffix ) = fileparse( $0, qr{\..+$} );
139        $SCRIPT_SUFFIX = $suffix;
140        my $script = lc $filename;
141        $script =~ s/^mt-//;
142        my $apps = $pkg->registry('applications');
143        $app_pkg = $apps->fetch( lc $script );
144        unless ($app_pkg) {
145            die "cannot determine application for script $0, stopped at";
146        }
147    }
148    $pkg->run_app( $app_pkg, \%param )
149      if $app_pkg;
150}
151
152sub run_app {
153    my $pkg = shift;
154    my ( $class, $param ) = @_;
155
156    # When running under FastCGI, the initial invocation of the
157    # script has a bare environment. We can use this to test
158    # for FastCGI.
159    my $not_fast_cgi = 0;
160    $not_fast_cgi ||= exists $ENV{$_}
161      for qw(HTTP_HOST GATEWAY_INTERFACE SCRIPT_FILENAME SCRIPT_URL);
162    my $fast_cgi = ( !$not_fast_cgi ) || $param->{fastcgi};
163    $fast_cgi =
164      defined( $param->{fastcgi} || $param->{FastCGI} )
165      ? ( $param->{fastcgi} || $param->{FastCGI} )
166      : $fast_cgi;
167    if ($fast_cgi) {
168        eval { require CGI::Fast; };
169        $fast_cgi = 0 if $@;
170    }
171
172    # ready to run now... run inside an eval block so we can gracefully
173    # die if something bad happens
174    my $app;
175    eval {
176        eval "require $class; 1;" or die $@;
177        if ($fast_cgi) {
178            my ($max_requests, $max_time, $cfg);
179            while ( my $cgi = new CGI::Fast ) {
180                $app = $class->new( %$param, CGIObject => $cgi )
181                  or die $class->errstr;
182
183                $app->{fcgi_startup_time} ||= time;
184                $app->{fcgi_request_count} = ( $app->{fcgi_request_count} || 0 ) + 1;
185
186                unless ( $cfg ) {
187                    $cfg = $app->config;
188                    $max_requests = $cfg->FastCGIMaxRequests;
189                    $max_time = $cfg->FastCGIMaxTime;
190                }
191
192                local $SIG{__WARN__} = sub { $app->trace( $_[0] ) };
193                $pkg->set_instance($app);
194                $app->init_request( CGIObject => $cgi );
195                $app->run;
196
197                # Check for timeout for this process
198                if ( $max_time && ( time - $app->{fcgi_startup_time} >= $max_time ) ) {
199                    last;
200                }
201                # Check for max executions for this process
202                if ( $max_requests && ( $app->{fcgi_request_count} >= $max_requests ) ) {
203                    last;
204                }
205            }
206        }
207        else {
208            $app = $class->new(%$param) or die $class->errstr;
209            local $SIG{__WARN__} = sub { $app->trace( $_[0] ) };
210            $app->run;
211        }
212    };
213    if ( my $err = $@ ) {
214        my $charset = 'utf-8';
215        eval {
216            $app ||= MT->instance;
217            my $cfg = $app->config;
218            my $c   = $app->find_config;
219            $cfg->read_config($c);
220            $charset = $cfg->PublishCharset;
221        };
222        if ( $app && UNIVERSAL::isa( $app, 'MT::App' ) ) {
223            eval {
224                my %param = ( error => $err );
225                if ( $err =~ m/Bad ObjectDriver/ ) {
226                    $param{error_database_connection} = 1;
227                }
228                elsif ( $err =~ m/Bad CGIPath/ ) {
229                    $param{error_cgi_path} = 1;
230                }
231                elsif ( $err =~ m/Missing configuration file/ ) {
232                    $param{error_config_file} = 1;
233                }
234                my $page = $app->build_page( 'error.tmpl', \%param )
235                  or die $app->errstr;
236                print "Content-Type: text/html; charset=$charset\n\n";
237                print $page;
238            };
239            if ( my $err = $@ ) {
240                print "Content-Type: text/plain; charset=$charset\n\n";
241                print $app
242                  ? $app->translate( "Got an error: [_1]", $err )
243                  : "Got an error: $err";
244            }
245        }
246        else {
247            if ( $err =~ m/Missing configuration file/ ) {
248                my $host = $ENV{SERVER_NAME} || $ENV{HTTP_HOST};
249                $host =~ s/:\d+//;
250                my $port = $ENV{SERVER_PORT};
251                my $uri = $ENV{REQUEST_URI} || $ENV{PATH_INFO};
252                $uri =~ s/mt(\Q$SCRIPT_SUFFIX\E)?.*$//;
253                my $cgipath = '';
254                $cgipath = $port == 443 ? 'https' : 'http';
255                $cgipath .= '://' . $host;
256                $cgipath .= ( $port == 443 || $port == 80 ) ? '' : ':' . $port;
257                $cgipath .= $uri;
258
259                print "Status: 302 Moved\n";
260                print "Location: " . $cgipath . "mt-wizard.cgi\n\n";
261            }
262            else {
263                print "Content-Type: text/plain; charset=$charset\n\n";
264                print $app
265                  ? $app->translate( "Got an error: [_1]", $err )
266                  : "Got an error: $err\n";
267            }
268        }
269    }
270}
271
272sub app {
273    my $class = shift;
274    $mt_inst ||= $mt_inst{$class} ||= $class->construct(@_);
275}
276*instance = *app;
277
278sub set_instance {
279    my $class = shift;
280    $mt_inst = shift;
281}
282
283sub new {
284    my $mt = &instance_of;
285    $mt_inst ||= $mt;
286    $mt;
287}
288
289sub instance_of {
290    my $class = shift;
291    $mt_inst{$class} ||= $class->construct(@_);
292}
293
294sub construct {
295    my $class = shift;
296    my $mt = bless {}, $class;
297    local $mt_inst = $mt;
298    $mt->init(@_)
299      or die $mt->errstr;
300    $mt;
301}
302
303{
304    my %object_types;
305
306    sub model {
307        my $pkg = shift;
308        my ($k) = @_;
309        $object_types{$k} = $_[1] if scalar @_ > 1;
310        return $object_types{$k} if exists $object_types{$k};
311
312        if ($k =~ m/^(.+):meta$/) {
313            my $ppkg = $pkg->model($1);
314            my $mpkg = $ppkg->meta_pkg;
315            return $mpkg ? $object_types{$k} = $mpkg : undef;
316        }
317
318        my $model = $pkg->registry( 'object_types', $k );
319        if ( ref($model) eq 'ARRAY' ) {
320
321            # First element of an array *should* be a scalar; in case it isn't,
322            # return undef.
323            $model = $model->[0];
324            return undef if ref $model;
325        }
326        elsif ( ref($model) eq 'HASH' ) {
327
328            # If all we have is a hash, this doesn't tell us the package for
329            # this object type, so it's undefined.
330            return undef;
331        }
332        return undef unless $model;
333
334        # Element in object type hash is scalar, so return it
335        no strict 'refs';
336        unless ( defined *{ $model . '::__properties' } ) {
337            use strict 'refs';
338            eval "# line " . __LINE__ . " " . __FILE__ . "\nrequire $model;";
339            if ( $@ && ( $k =~ m/^(.+)\./ ) ) {
340
341                # x.foo can't be found, so try loading x
342                if ( my $ppkg = $pkg->model($1) ) {
343
344                    # well now see if $model is defined
345                    no strict 'refs';
346                    unless ( defined *{ $model . '::__properties' } ) {
347
348                        # if not, use parent package instead
349                        $model = $ppkg;
350                    }
351                }
352            }
353        }
354        return $object_types{$k} = $model;
355    }
356
357    sub models {
358        my $pkg = shift;
359        my ($k) = @_;
360
361        my @matches;
362        my $model = $pkg->registry('object_types');
363        foreach my $m ( keys %$model ) {
364            if ( $m =~ m/^\Q$k\E\.?/ ) {
365                push @matches, $m;
366            }
367        }
368        return @matches;
369    }
370}
371
372sub registry {
373    my $pkg = shift;
374
375    # if (!ref $pkg) {
376    #     return $pkg->instance->registry(@_);
377    # }
378    require MT::Component;
379    my $regs = MT::Component->registry(@_);
380    my $r;
381    if ($regs) {
382        foreach my $cr (@$regs) {
383
384            # in the event that our registry request returns something
385            # other than an array of hashes, return it as is instead of
386            # merging it together.
387            return $regs unless ref($cr) eq 'HASH';
388
389            # next unless ref($cr) eq 'HASH';
390            delete $cr->{plugin} if exists $cr->{plugin};
391            __merge_hash( $r ||= {}, $cr );
392        }
393    }
394    return $r;
395}
396
397# merges contents of two hashes, giving preference to the right side
398# if $replace is true; otherwise it will always append to the left side.
399sub __merge_hash {
400    my ( $h1, $h2, $replace ) = @_;
401    for my $k ( keys(%$h2) ) {
402        if ( exists( $h1->{$k} ) && ( !$replace ) ) {
403            if ( ref $h1->{$k} eq 'HASH' ) {
404                __merge_hash( $h1->{$k}, $h2->{$k}, ( $replace || 0 ) + 1 );
405            }
406            elsif ( ref $h1->{$k} eq 'ARRAY' ) {
407                if ( ref $h2->{$k} eq 'ARRAY' ) {
408                    push @{ $h1->{$k} }, @{ $h2->{$k} };
409                }
410                else {
411                    push @{ $h1->{$k} }, $h2->{$k};
412                }
413            }
414            else {
415                $h1->{$k} = [ $h1->{$k}, $h2->{$k} ];
416            }
417        }
418        else {
419            $h1->{$k} = $h2->{$k};
420        }
421    }
422}
423
424# The above functions can all be used to make MT objects (and subobjects).
425# The difference between them is characterized by these assertions:
426#
427#  $mt = MT::App::Search->new();
428#  assert($mt->isa('MT::App::Search'))
429#
430#  $mt1 = MT->instance
431#  $mt2 = MT->instance
432#  assert($mt1 == $mt2);
433#
434#  $mt1 = MT::App::CMS->construct()
435#  $mt2 = MT::App::CMS->construct()
436#  assert($mt1 != $mt2);
437#
438# TBD: make a test script for these.
439
440sub unplug {
441}
442
443sub config {
444    my $mt = shift;
445    ref $mt or $mt = MT->instance;
446    unless ( $mt->{cfg} ) {
447        require MT::ConfigMgr;
448        weaken( $mt->{cfg} = MT::ConfigMgr->instance );
449    }
450    if (@_) {
451        my $setting = shift;
452        @_ ? $mt->{cfg}->set( $setting, @_ ) : $mt->{cfg}->get($setting);
453    }
454    else {
455        $mt->{cfg};
456    }
457}
458
459sub request {
460    my $pkg  = shift;
461    my $inst = ref($pkg) ? $pkg : $pkg->instance;
462    unless ( $inst->{request} ) {
463        require MT::Request;
464        $inst->{request} = MT::Request->instance;
465    }
466    if (@_) {
467        $inst->{request}->stash(@_);
468    }
469    else {
470        $inst->{request};
471    }
472}
473
474sub log {
475    my $mt = shift;
476    unless ($plugins_installed) {
477        # finish init_schema here since we have to log something
478        # to the database.
479        $mt->init_schema();
480    }
481    my $msg;
482    if ( !@_ ) {    # single parameter to log, so $mt must be message
483        $msg = $mt;
484        $mt  = MT->instance;
485    }
486    else {          # multiple parameters to log; second one is message
487        $msg = shift;
488    }
489    my $log_class = $mt->model('log');
490    my $log = $log_class->new();
491    if ( ref $msg eq 'HASH' ) {
492        $log->set_values($msg);
493    }
494    elsif ( ( ref $msg ) && ( UNIVERSAL::isa( $msg, 'MT::Log' ) ) ) {
495        $log = $msg;
496    }
497    else {
498        $log->message($msg);
499    }
500    $log->level( MT::Log::INFO() )
501      unless defined $log->level;
502    $log->class('system')
503      unless defined $log->class;
504    $log->save();
505    print STDERR MT->translate( "Message: [_1]", $log->message ) . "\n"
506      if $MT::DebugMode;
507}
508my $plugin_full_path;
509
510sub run_tasks {
511    my $mt = shift;
512    require MT::TaskMgr;
513    MT::TaskMgr->run_tasks(@_);
514}
515
516sub add_plugin {
517    my $class = shift;
518    my ($plugin) = @_;
519    if ( ref $plugin eq 'HASH' ) {
520        require MT::Plugin;
521        $plugin = new MT::Plugin($plugin);
522    }
523    $plugin->{name} ||= $plugin_sig;
524    $plugin->{plugin_sig} = $plugin_sig;
525
526    my $id = $plugin->id;
527    unless ($plugin_envelope) {
528        warn "MT->add_plugin improperly called outside of MT plugin load loop.";
529        return;
530    }
531    $plugin->envelope($plugin_envelope);
532    Carp::confess("You cannot register multiple plugin objects from a single script. $plugin_sig")
533      if exists( $Plugins{$plugin_sig} )
534      && ( exists $Plugins{$plugin_sig}{object} );
535
536    $Components{ lc $id } = $plugin if $id;
537    $Plugins{$plugin_sig}{object} = $plugin;
538    $plugin->{full_path}  = $plugin_full_path;
539    $plugin->path($plugin_full_path);
540    unless ( $plugin->{registry} && ( %{ $plugin->{registry} } ) ) {
541        $plugin->{registry} = $plugin_registry;
542    }
543    if ( $plugin->{registry} ) {
544        if ( my $settings = $plugin->{registry}{config_settings} ) {
545            $settings = $plugin->{registry}{config_settings} = $settings->()
546              if ref($settings) eq 'CODE';
547            $class->config->define($settings);
548        }
549    }
550    push @Components, $plugin;
551    1;
552}
553
554our %CallbackAlias;
555our $CallbacksEnabled = 1;
556my %CallbacksEnabled;
557my @Callbacks;
558
559sub add_callback {
560    my $class = shift;
561    my ( $meth, $priority, $plugin, $code ) = @_;
562    if ( $meth =~ m/^(.+::)?([^\.]+)(\..+)?$/ ) {
563
564        # Remap (whatever)::(name).(something)
565        if ( exists $CallbackAlias{$2} ) {
566            $meth = $CallbackAlias{$2};
567            $meth = $1 . $meth if $1;
568            $meth = $meth . $3 if $3;
569        }
570    }
571    $meth = $CallbackAlias{$meth} if exists $CallbackAlias{$meth};
572    my $internal = 0;
573    if ( ref $plugin ) {
574        if ( ( defined $mt_inst ) && ( $plugin == $mt_inst ) ) {
575            $plugin   = undef;
576            $internal = 1;
577        }
578        elsif ( !UNIVERSAL::isa( $plugin, "MT::Component" ) ) {
579            return $class->trans_error(
580"If present, 3rd argument to add_callback must be an object of type MT::Component or MT::Plugin"
581            );
582        }
583    }
584    if ( ( ref $code ) ne 'CODE' ) {
585        if ( ref $code ) {
586            return $class->trans_error(
587                '4th argument to add_callback must be a CODE reference.');
588        }
589        else {
590            # Defer until callback is used
591            # if ($plugin) {
592            #     $code = MT->handler_to_coderef($code);
593            # }
594        }
595    }
596
597    # 0 and 11 are exclusive.
598    if ( $priority == 0 || $priority == 11 ) {
599        if ( $Callbacks[$priority]->{$meth} ) {
600            return $class->trans_error("Two plugins are in conflict");
601        }
602    }
603    return $class->trans_error( "Invalid priority level [_1] at add_callback",
604        $priority )
605      if ( ( $priority < 0 ) || ( $priority > 11 ) );
606    require MT::Callback;
607    $CallbacksEnabled{$meth} = 1;
608    ## push @{$Plugins{$plugin_sig}{callbacks}}, "$meth Callback" if $plugin_sig;
609    my $cb = new MT::Callback(
610        plugin   => $plugin,
611        code     => $code,
612        priority => $priority,
613        internal => $internal,
614        method   => $meth
615    );
616    push @{ $Callbacks[$priority]->{$meth} }, $cb;
617    $cb;
618}
619
620sub remove_callback {
621    my $class    = shift;
622    my ($cb)     = @_;
623    my $priority = $cb->{priority};
624    my $method   = $cb->{method};
625    my $list     = $Callbacks[$priority];
626    return unless $list;
627    my $cbarr = $list->{$method};
628    return unless $cbarr;
629    @$cbarr = grep { $_ != $cb } @$cbarr;
630}
631
632# For use by MT internal code
633sub _register_core_callbacks {
634    my $class = shift;
635    my ($callback_table) = @_;
636    foreach my $name ( keys %$callback_table ) {
637        $class->add_callback( $name, 5, $mt_inst, $callback_table->{$name} )
638          || return;
639    }
640    1;
641}
642
643sub register_callbacks {
644    my $class = shift;
645    my ($callback_list) = @_;
646    foreach my $cb (@$callback_list) {
647        $class->add_callback( $cb->{name}, $cb->{priority}, $cb->{plugin},
648            $cb->{code} )
649          || return;
650    }
651    1;
652}
653
654our $CB_ERR;
655sub callback_error { $CB_ERR = $_[0]; }
656sub callback_errstr { $CB_ERR }
657
658sub run_callback {
659    my $class = shift;
660    my ( $cb, @args ) = @_;
661
662    $cb->error();    # reset the error string
663    my $result = eval {
664        # line __LINE__ __FILE__
665        $cb->invoke(@args);
666    };
667    if ( my $err = $@ ) {
668        $cb->error($err);
669        my $plugin = $cb->{plugin};
670        my $name;
671        if ( $cb->{internal} ) {
672            $name = "Internal callback";
673        }
674        elsif ( UNIVERSAL::isa( $plugin, 'MT::Plugin' ) ) {
675            $name = $plugin->name() || MT->translate("Unnamed plugin");
676        }
677        else {
678            $name = MT->translate("Unnamed plugin");
679        }
680        require MT::Log;
681        MT->log(
682            {
683                message => MT->translate( "[_1] died with: [_2]", $name, $err ),
684                class   => 'system',
685                category => 'callback',
686                level    => MT::Log::ERROR(),
687            }
688        );
689        return 0;
690    }
691    if ( $cb->errstr() ) {
692        return 0;
693    }
694    return $result;
695}
696
697# A callback should return a true/false value. The result of
698# run_callbacks is the logical AND of all the callback's return
699# values. Some hookpoints will ignore the return value: e.g. object
700# callbacks don't use it. By convention, those that use it have Filter
701# at the end of their names (CommentPostFilter, CommentThrottleFilter,
702# etc.)
703# Note: this composition is not short-circuiting. All callbacks are
704# executed even if one has already returned false.
705# ALSO NOTE: failure (dying or setting $cb->errstr) does not force a
706# "false" return.
707# THINK: are there cases where a true value should override all false values?
708# that is, where logical OR is the right way to compose multiple callbacks?
709sub run_callbacks {
710    my $class = shift;
711    my ( $meth, @args ) = @_;
712    return 1 unless $CallbacksEnabled && %CallbacksEnabled;
713    $meth = $CallbackAlias{$meth} if exists $CallbackAlias{$meth};
714    my @methods;
715
716    # execution:
717    #   Full::Name.<variant>
718    #   *::Name.<variant> OR Name.<variant>
719    #   Full::Name
720    #   *::Name OR Name
721    push @methods, $meth if $CallbacksEnabled{$meth};    # bleh::blah variant
722    if ( $meth =~ /::/ ) {    # presence of :: implies it's an obj. cb
723        my $name = $meth;
724        $name =~ s/^.*::([^:]*)$/$1/;
725        $name = $CallbackAlias{ '*::' . $name }
726          if exists $CallbackAlias{ '*::' . $name };
727        push @methods, '*::' . $name
728          if $CallbacksEnabled{ '*::' . $name };    # *::blah variant
729        push @methods, $name if $CallbacksEnabled{$name};    # blah variant
730    }
731    if ( $meth =~ /\./ ) {    # presence of ' ' implies it is a variant callback
732        my ($name) = split /\./, $meth, 2;
733        $name = $CallbackAlias{$name} if exists $CallbackAlias{$name};
734        push @methods, $name if $CallbacksEnabled{$name};    # bleh::blah
735        if ( $name =~ m/::/ ) {
736            my $name2 = $name;
737            $name2 =~ s/^.*::([^:]*)$/$1/;
738            $name2 = $CallbackAlias{ '*::' . $name2 }
739              if exists $CallbackAlias{ '*::' . $name2 };
740            push @methods, '*::' . $name2
741              if $CallbacksEnabled{ '*::' . $name2 };        # *::blah
742            push @methods, $name2 if $CallbacksEnabled{$name2};    # blah
743        }
744    }
745    return 1 unless @methods;
746
747    $CallbacksEnabled{$_} = 0 for @methods;
748    my @errors;
749    my $filter_value = 1;
750    my $first_error;
751
752    foreach my $callback_sheaf (@Callbacks) {
753        for my $meth (@methods) {
754            if ( my $set = $callback_sheaf->{$meth} ) {
755                for my $cb (@$set) {
756                    my $result = $class->run_callback( $cb, @args );
757                    $filter_value &&= $result;
758                    if ( !$result ) {
759                        if ( $cb->errstr() ) {
760                            push @errors, $cb->errstr();
761                        }
762                        if ( !defined($first_error) ) {
763                            $first_error = $cb->errstr();
764                        }
765                    }
766                }
767            }
768        }
769    }
770
771    callback_error( join( '', @errors ) );
772
773    $CallbacksEnabled{$_} = 1 for @methods;
774    if ( !$filter_value ) {
775        return $class->error($first_error);
776    }
777    else {
778        return $filter_value;
779    }
780}
781
782sub user_class {
783    shift->{user_class};
784}
785
786sub find_config {
787    my $mt = shift;
788    my ($param) = @_;
789
790    $param->{Config}    ||= $ENV{MT_CONFIG};
791    $param->{Directory} ||= $ENV{MT_HOME};
792    if ( !$param->{Directory} ) {
793        if ( $param->{Config} ) {
794            $param->{Directory} = dirname( $param->{Config} );
795        }
796        else {
797            $param->{Directory} = dirname($0) || $ENV{PWD} || '.';
798        }
799    }
800
801    # the directory is the more important parameter between it and
802    # the config parameter. if config is unreadable, then scan for
803    # a config file using the directory as a base.  we support
804    # either mt.cfg or mt-config.cgi for the config file name. the
805    # latter being a more secure choice since it is unreadable from
806    # a browser.
807    for my $cfg_file ( $param->{Config},
808        File::Spec->catfile( $param->{Directory}, 'mt-config.cgi' ),
809        'mt-config.cgi' )
810    {
811        return $cfg_file if $cfg_file && -r $cfg_file && -f $cfg_file;
812    }
813    return undef;
814}
815
816sub init_schema {
817    require MT::Object;
818    MT::Object->install_pre_init_properties();
819}
820
821sub init_permissions {
822    require MT::Permission;
823    MT::Permission->init_permissions;
824}
825
826sub init_config {
827    my $mt = shift;
828    my ($param) = @_;
829
830    my $cfg_file = $mt->find_config($param);
831    return $mt->error(
832"Missing configuration file. Maybe you forgot to move mt-config.cgi-original to mt-config.cgi?"
833    ) unless $cfg_file;
834    $cfg_file = File::Spec->rel2abs($cfg_file);
835
836    # translate the config file's location to an absolute path, so we
837    # can use that directory as a basis for calculating other relative
838    # paths found in the config file.
839    my $config_dir = $mt->{config_dir} = dirname($cfg_file);
840
841    # store the mt_dir (home) as an absolute path; fallback to the config
842    # directory if it isn't set.
843    $mt->{mt_dir} =
844      $param->{Directory}
845      ? File::Spec->rel2abs( $param->{Directory} )
846      : $mt->{config_dir};
847    $mt->{mt_dir} ||= dirname($0);
848
849    # also make note of the active application path; this is derived by
850    # checking the PWD environment variable, the dirname of $0,
851    # the directory of SCRIPT_FILENAME and lastly, falls back to mt_dir
852    $mt->{app_dir} = $ENV{PWD} || "";
853    $mt->{app_dir} = dirname($0)
854      if !$mt->{app_dir}
855      || !File::Spec->file_name_is_absolute( $mt->{app_dir} );
856    $mt->{app_dir} = dirname( $ENV{SCRIPT_FILENAME} )
857      if $ENV{SCRIPT_FILENAME}
858      && ( !$mt->{app_dir}
859        || ( !File::Spec->file_name_is_absolute( $mt->{app_dir} ) ) );
860    $mt->{app_dir} ||= $mt->{mt_dir};
861    $mt->{app_dir} = File::Spec->rel2abs( $mt->{app_dir} );
862
863    my $cfg = $mt->config;
864    $cfg->define( $mt->registry('config_settings') );
865    $cfg->read_config($cfg_file) or return $mt->error( $cfg->errstr );
866    $mt->{cfg_file} = $cfg_file;
867
868    my @mt_paths = $cfg->paths;
869    for my $meth (@mt_paths) {
870        my $path = $cfg->get( $meth, undef );
871        my $type = $cfg->type($meth);
872        if ( defined $path ) {
873            if ( $type eq 'ARRAY' ) {
874                my @paths = $cfg->get($meth);
875                local $_;
876                foreach (@paths) {
877                    next if File::Spec->file_name_is_absolute($_);
878                    $_ = File::Spec->catfile( $config_dir, $_ );
879                }
880                $cfg->$meth( \@paths );
881            }
882            else {
883                if ( !File::Spec->file_name_is_absolute($path) ) {
884                    $path = File::Spec->catfile( $config_dir, $path );
885                    $cfg->$meth($path);
886                }
887            }
888        }
889        else {
890            next if $type eq 'ARRAY';
891            my $path = $cfg->default($meth);
892            if ( defined $path ) {
893                $cfg->$meth( File::Spec->catfile( $config_dir, $path ) );
894            }
895        }
896    }
897
898    return $mt->trans_error("Bad ObjectDriver config")
899      unless $cfg->ObjectDriver;
900
901    if ( $MT::DebugMode = $cfg->DebugMode ) {
902        require Data::Dumper;
903        $Data::Dumper::Terse    = 1;
904        $Data::Dumper::Maxdepth = 4;
905        $Data::Dumper::Sortkeys = 1;
906        $Data::Dumper::Indent   = 1;
907    }
908
909    if ($cfg->PerformanceLogging && $cfg->ProcessMemoryCommand) {
910        $mt->log_times();
911    }
912
913    $mt->set_language( $cfg->DefaultLanguage );
914
915    my $cgi_path = $cfg->CGIPath;
916    if ( !$cgi_path || $cgi_path =~ m!http://www\.example\.com/! ) {
917        return $mt->trans_error("Bad CGIPath config");
918    }
919
920    $mt->{cfg} = $cfg;
921
922    1;
923}
924
925{
926my ($memory_start);
927sub log_times {
928    my $pkg = shift;
929
930    my $timer = $pkg->get_timer;
931    return unless $timer;
932
933    my $memory;
934    my $cmd = $pkg->config->ProcessMemoryCommand;
935    if ($cmd) {
936        my $re;
937        if (ref($cmd) eq 'HASH') {
938            $re = $cmd->{regex};
939            $cmd = $cmd->{command};
940        }
941        $cmd =~ s/\$\$/$$/g;
942        $memory = `$cmd`;
943        if ($re) {
944            if ($memory =~ m/$re/) {
945                $memory = $1;
946                $memory =~ s/\D//g;
947            }
948        } else {
949            $memory =~ s/\s+//gs;
950        }
951    }
952
953    # Called at the start of the process; so we're only recording
954    # the memory usage at the start of the app right now.
955    unless ($timer->{elapsed}) {
956        $memory_start = $memory;
957        return;
958    }
959
960    require File::Spec;
961    my $dir = MT->config('PerformanceLoggingPath') or return;
962
963    my @time = localtime(time);
964    my $file = sprintf("pl-%04d%02d%02d.log", $time[5] + 1900, $time[4]+1, $time[3]);
965    my $log_file = File::Spec->catfile( $dir, $file );
966
967    my $first_write = ! -f $log_file;
968
969    local *PERFLOG;
970    open PERFLOG, ">>$log_file";
971    require Fcntl;
972    flock(PERFLOG, Fcntl::LOCK_EX());
973
974    if ($first_write) {
975        require Config;
976        my ($osname, $osvers) = ($Config::Config{osname}, $Config::Config{osvers});
977        print PERFLOG "# Operating System: $osname/$osvers\n";
978        print PERFLOG "# Platform: $^O\n";
979        my $ver = ref($^V) eq 'version' ? $^V->normal : ( $^V ? join('.', unpack 'C*', $^V) : $] );
980        print PERFLOG "# Perl Version: $ver\n";
981        print PERFLOG "# Web Server: $ENV{SERVER_SOFTWARE}\n";
982        require MT::Object;
983        my $driver = MT::Object->driver;
984        if ($driver) {
985            my $dbh = $driver->r_handle;
986            if ($dbh) {
987                my $dbname = $dbh->get_info( 17 ); # SQL_DBMS_NAME
988                my $dbver = $dbh->get_info( 18 ); # SQL_DBMS_VER
989                if ($dbname && $dbver) {
990                    print PERFLOG "# Database: $dbname/$dbver\n";
991                }
992            }
993        }
994        my ($drname, $drh) = each %DBI::installed_drh;
995        print PERFLOG "# Database Library: DBI/" . $DBI::VERSION . "; DBD/" . $drh->{Version} . "\n";
996        if ($ENV{MOD_PERL}) {
997            print PERFLOG "# App Mode: mod_perl\n";
998        }
999        elsif ($ENV{FAST_CGI}) {
1000            print PERFLOG "# App Mode: FastCGI\n";
1001        }
1002        else {
1003            print PERFLOG "# App Mode: CGI\n";
1004        }
1005    }
1006
1007    if ($memory) {
1008        print PERFLOG $timer->dump_line("mem_start=$memory_start", "mem_end=$memory");
1009    } else {
1010        print PERFLOG $timer->dump_line();
1011    }
1012
1013    close PERFLOG;
1014}
1015}
1016
1017sub get_timer {
1018    my $mt = shift;
1019    $mt = MT->instance unless ref $mt;
1020    my $timer = $mt->request('timer');
1021    unless (defined $timer) {
1022        if (MT->config('PerformanceLogging')) {
1023            my $uri;
1024            if ($mt->isa('MT::App')) {
1025                $uri = $mt->uri( args => { $mt->param_hash } );
1026            }
1027            require MT::Util::ReqTimer;
1028            $timer = MT::Util::ReqTimer->new( $uri );
1029        } else {
1030            $timer = 0;
1031        }
1032        $mt->request('timer', $timer);
1033    }
1034    return $timer;
1035}
1036
1037sub time_this {
1038    my $mt = shift;
1039    my ($str, $code) = @_;
1040    my $timer = $mt->get_timer();
1041    my $ret;
1042    if ($timer) {
1043        $timer->pause_partial();
1044        $ret = $code->();
1045        $timer->mark($str);
1046    } else {
1047        $ret = $code->();
1048    }
1049    return $ret;
1050}
1051
1052sub init_config_from_db {
1053    my $mt = shift;
1054    my ($param) = @_;
1055    my $cfg = $mt->config;
1056    $cfg->read_config_db();
1057
1058    # Tell any instantiated drivers to reconfigure themselves as necessary
1059    MT::ObjectDriverFactory->configure;
1060
1061    1;
1062}
1063
1064sub bootstrap {
1065    my $pkg = shift;
1066    $pkg->init_paths() or return;
1067    $pkg->init_core()  or return;
1068}
1069
1070sub init_paths {
1071    my $mt = shift;
1072    my ($param) = @_;
1073
1074    # determine MT directory
1075    my ($orig_dir);
1076    require File::Spec;
1077    if ( !( $MT_DIR = $ENV{MT_HOME} ) ) {
1078        if ( $0 =~ m!(.*([/\\]))! ) {
1079            $orig_dir = $MT_DIR = $1;
1080            my $slash = $2;
1081            $MT_DIR =~ s!(?:[/\\]|^)(?:plugins[/\\].*|tools[/\\])$!$slash!;
1082            $MT_DIR = '' if ( $MT_DIR =~ m!^\.?[\\/]$! );
1083        }
1084        else {
1085
1086            # MT_DIR/lib/MT.pm -> MT_DIR/lib -> MT_DIR
1087            $MT_DIR = dirname( dirname( File::Spec->rel2abs(__FILE__) ) );
1088        }
1089        unless ($MT_DIR) {
1090            $orig_dir = $MT_DIR = $ENV{PWD} || '.';
1091            $MT_DIR =~ s!(?:[/\\]|^)(?:plugins[/\\].*|tools[/\\]?)$!!;
1092        }
1093        $ENV{MT_HOME} = $MT_DIR;
1094    }
1095    unshift @INC, File::Spec->catdir( $MT_DIR,   'extlib' );
1096    unshift @INC, File::Spec->catdir( $orig_dir, 'lib' )
1097      if $orig_dir && ( $orig_dir ne $MT_DIR );
1098
1099    $mt->set_language('en_US');
1100
1101    if ( my $cfg_file = $mt->find_config($param) ) {
1102        $cfg_file = File::Spec->rel2abs($cfg_file);
1103        $CFG_FILE = $cfg_file;
1104    }
1105    else {
1106        return $mt->trans_error(
1107"Missing configuration file. Maybe you forgot to move mt-config.cgi-original to mt-config.cgi?"
1108        ) if ref($mt);
1109    }
1110
1111    # store the mt_dir (home) as an absolute path; fallback to the config
1112    # directory if it isn't set.
1113    $MT_DIR ||=
1114      $param->{directory}
1115      ? File::Spec->rel2abs( $param->{directory} )
1116      : $CFG_DIR;
1117    $MT_DIR ||= dirname($0);
1118
1119    # also make note of the active application path; this is derived by
1120    # checking the PWD environment variable, the dirname of $0,
1121    # the directory of SCRIPT_FILENAME and lastly, falls back to mt_dir
1122    $APP_DIR = $ENV{PWD} || "";
1123    $APP_DIR = dirname($0)
1124      if !$APP_DIR || !File::Spec->file_name_is_absolute($APP_DIR);
1125    $APP_DIR = dirname( $ENV{SCRIPT_FILENAME} )
1126      if $ENV{SCRIPT_FILENAME}
1127      && ( !$APP_DIR || ( !File::Spec->file_name_is_absolute($APP_DIR) ) );
1128    $APP_DIR ||= $MT_DIR;
1129    $APP_DIR = File::Spec->rel2abs($APP_DIR);
1130
1131    return 1;
1132}
1133
1134sub init_core {
1135    my $mt = shift;
1136    return if exists $Components{'core'};
1137    require MT::Core;
1138    my $c = MT::Core->new( { id => 'core', path => $MT_DIR } )
1139      or die MT::Core->errstr;
1140    $Components{'core'} = $c;
1141
1142    push @Components, $c;
1143    return 1;
1144}
1145
1146sub init_lang_defaults {
1147    my $mt = shift;
1148    my $cfg = $mt->config;
1149   
1150    $cfg->DefaultLanguage('en_US') unless $cfg->DefaultLanguage;
1151   
1152    my %lang_settings = (
1153        'NewsboxURL'         => 'NEWSBOX_URL',
1154        'LearningNewsURL'    => 'LEARNINGNEWS_URL',
1155        'SupportURL'         => 'SUPPORT_URL',
1156        'NewsURL'            => 'NEWS_URL',
1157        'DefaultTimezone'    => 'DEFAULT_TIMEZONE',
1158        'TimeOffset'         => 'DEFAULT_TIMEZONE',
1159        'MailEncoding'       => 'MAIL_ENCODING',
1160        'ExportEncoding'     => 'EXPORT_ENCODING',
1161        'LogExportEncoding'  => 'LOG_EXPORT_ENCODING',
1162        'CategoryNameNodash' => 'CATEGORY_NAME_NODASH',
1163        'PublishCharset'     => 'PUBLISH_CHARSET'
1164    );
1165
1166    require MT::I18N;
1167    foreach my $setting (keys %lang_settings) {
1168        my $const = $lang_settings{$setting};
1169        my $value = $cfg->$setting;
1170        my $i18n_val = MT::I18N::const($const);
1171        if ( !$value ) {
1172            $cfg->$setting($i18n_val);
1173        }
1174        elsif ( ( $value eq $cfg->default($setting) )
1175             && ( $value ne $i18n_val ) ) {
1176            $cfg->$setting($i18n_val);
1177        }
1178    }
1179   
1180    return 1;
1181}
1182
1183sub init {
1184    my $mt    = shift;
1185    my %param = @_;
1186
1187    $mt->bootstrap() unless $MT_DIR;
1188    $mt->{mt_dir}     = $MT_DIR;
1189    $mt->{config_dir} = $CFG_DIR;
1190    $mt->{app_dir}    = $APP_DIR;
1191
1192    $mt->init_callbacks();
1193
1194    ## Initialize the language to the default in case any errors occur in
1195    ## the rest of the initialization process.
1196    $mt->init_config( \%param ) or return;
1197    $mt->init_lang_defaults(@_) or return;
1198    require MT::Plugin;
1199    $mt->init_addons(@_)       or return;
1200    $mt->init_config_from_db( \%param ) or return;
1201    $mt->init_plugins(@_)       or return;
1202    $plugins_installed = 1;
1203    $mt->init_schema();
1204    $mt->init_permissions();
1205
1206    # Load MT::Log so constants are available
1207    require MT::Log;
1208
1209    $mt->run_callbacks('post_init', $mt, \%param);
1210    return $mt;
1211}
1212
1213sub init_callbacks {
1214    my $mt = shift;
1215    MT->_register_core_callbacks({
1216        'build_file_filter' => sub { MT->publisher->queue_build_file_filter(@_) },
1217        'cms_upload_file' => \&core_upload_file_to_sync,
1218        'api_upload_file' => \&core_upload_file_to_sync,
1219    });
1220}
1221
1222sub core_upload_file_to_sync {
1223    my ($cb, %args) = @_;
1224    MT->upload_file_to_sync(%args);
1225}
1226
1227sub upload_file_to_sync {
1228    my $class = shift;
1229    my (%args) = @_;
1230
1231    # no need to do this unless we're syncing stuff.
1232    return unless MT->config('SyncTarget');
1233
1234    my $url = $args{url};
1235    my $file = $args{file};
1236    return unless -f $file;
1237
1238    my $blog = $args{blog};
1239    my $blog_id = $blog->id;
1240    return unless $blog->publish_queue;
1241
1242    require MT::FileInfo;
1243    my $base_url = $url;
1244    $base_url =~ s!^https?://[^/]+!!;
1245    my $fi = MT::FileInfo->load({ blog_id => $blog_id, url => $base_url });
1246    if (!$fi) {
1247        $fi = new MT::FileInfo;
1248        $fi->blog_id($blog_id);
1249        $fi->url($base_url);
1250        $fi->file_path($file);
1251    } else {
1252        $fi->file_path($file);
1253    }
1254    $fi->save;
1255
1256    require MT::TheSchwartz;
1257    require TheSchwartz::Job;
1258    my $job = TheSchwartz::Job->new();
1259    $job->funcname('MT::Worker::Sync');
1260    $job->uniqkey( $fi->id );
1261    $job->coalesce( ( $fi->blog_id || 0 ) . ':' . $$ . ':' . ( time - ( time % 10 ) ) );
1262    MT::TheSchwartz->insert($job);
1263}
1264
1265sub init_addons {
1266    my $mt = shift;
1267    my $cfg = $mt->config;
1268    my @PluginPaths;
1269
1270    unshift @PluginPaths, File::Spec->catdir( $MT_DIR, 'addons' );
1271    return $mt->_init_plugins_core({}, 1, \@PluginPaths);
1272}
1273
1274sub init_plugins {
1275    my $mt = shift;
1276
1277    # Load compatibility module for prior version
1278    # This should always be MT::Compat::v(MAJOR_RELEASE_VERSION - 1).
1279    require MT::Compat::v3;
1280
1281    my $cfg          = $mt->config;
1282    my $use_plugins  = $cfg->UsePlugins;
1283    my @PluginPaths  = $cfg->PluginPath;
1284    my $PluginSwitch = $cfg->PluginSwitch || {};
1285    return $mt->_init_plugins_core($PluginSwitch, $use_plugins, \@PluginPaths);
1286}
1287
1288sub _init_plugins_core {
1289    my $mt = shift;
1290    my ($PluginSwitch, $use_plugins, $PluginPaths) = @_;
1291
1292    my $timer;
1293    if ($mt->config->PerformanceLogging) {
1294        $timer = $mt->get_timer();
1295    }
1296
1297    foreach my $PluginPath (@$PluginPaths) {
1298        my $plugin_lastdir = $PluginPath;
1299        $plugin_lastdir =~ s![\\/]$!!;
1300        $plugin_lastdir =~ s!.*[\\/]!!;
1301        local *DH;
1302        if ( opendir DH, $PluginPath ) {
1303            my @p = readdir DH;
1304          PLUGIN:
1305            for my $plugin (@p) {
1306                next if ( $plugin =~ /^\.\.?$/ || $plugin =~ /~$/ );
1307
1308                my $load_plugin = sub {
1309                    my ( $plugin, $sig ) = @_;
1310                    die "Bad plugin filename '$plugin'"
1311                      if ( $plugin !~ /^([-\\\/\@\:\w\.\s~]+)$/ );
1312                    local $plugin_sig      = $sig;
1313                    local $plugin_registry = {};
1314                    $plugin = $1;
1315                    if (
1316                        !$use_plugins
1317                        || ( exists $PluginSwitch->{$plugin_sig}
1318                            && !$PluginSwitch->{$plugin_sig} )
1319                      )
1320                    {
1321                        $Plugins{$plugin_sig}{full_path} = $plugin_full_path;
1322                        $Plugins{$plugin_sig}{enabled}   = 0;
1323                        return 0;
1324                    }
1325                    return 0 if exists $Plugins{$plugin_sig};
1326                    $Plugins{$plugin_sig}{full_path} = $plugin_full_path;
1327                    $timer->pause_partial if $timer;
1328                    eval "# line " . __LINE__ . " " . __FILE__ . "\nrequire '$plugin';";
1329                    $timer->mark("Loaded plugin " . $sig) if $timer;
1330                    if ($@) {
1331                        $Plugins{$plugin_sig}{error} = $@;
1332                        # Issue MT log within another eval block in the
1333                        # event that the plugin error is happening before
1334                        # the database has been initialized...
1335                        eval {
1336                            # line __LINE__ __FILE__
1337                            require MT::Log;
1338                            $mt->log(
1339                                {
1340                                    message => $mt->translate(
1341                                        "Plugin error: [_1] [_2]", $plugin,
1342                                        $Plugins{$plugin_sig}{error}
1343                                    ),
1344                                    class => 'system',
1345                                    level => MT::Log::ERROR()
1346                                }
1347                            );
1348                        };
1349                        return 0;
1350                    }
1351                    else {
1352                        if ( my $obj = $Plugins{$plugin_sig}{object} ) {
1353                            $obj->init_callbacks();
1354                        }
1355                        else {
1356
1357                            # A plugin did not register itself, so
1358                            # create a dummy plugin object which will
1359                            # cause it to show up in the plugin listing
1360                            # by it's filename.
1361                            MT->add_plugin( {} );
1362                        }
1363                    }
1364                    $Plugins{$plugin_sig}{enabled} = 1;
1365                    return 1;
1366                };
1367                $plugin_full_path = File::Spec->catfile( $PluginPath, $plugin );
1368                if ( -f $plugin_full_path ) {
1369                    $plugin_envelope = $plugin_lastdir;
1370                    $load_plugin->( $plugin_full_path, $plugin )
1371                      if $plugin_full_path =~ /\.pl$/;
1372                }
1373                else {
1374                    my $plugin_dir = $plugin;
1375                    $plugin_envelope = "$plugin_lastdir/" . $plugin;
1376
1377                    # handle config.yaml
1378                    my $yaml =
1379                      File::Spec->catdir( $plugin_full_path, 'config.yaml' );
1380
1381                    foreach my $lib (qw(lib extlib)) {
1382                        my $plib = File::Spec->catdir( $plugin_full_path, $lib );
1383                        unshift @INC, $plib if -d $plib;
1384                    }
1385
1386                    if ( -f $yaml ) {
1387                        my $pclass =
1388                          $plugin_dir =~ m/\.pack$/
1389                          ? 'MT::Component'
1390                          : 'MT::Plugin';
1391
1392                        # Don't process disabled plugin config.yaml files.
1393                        if (
1394                            $pclass eq 'MT::Plugin'
1395                            && (
1396                                !$use_plugins
1397                                || ( exists $PluginSwitch->{$plugin_dir}
1398                                    && !$PluginSwitch->{$plugin_dir} )
1399                            )
1400                          )
1401                        {
1402                            $Plugins{$plugin_dir}{full_path} =
1403                              $plugin_full_path;
1404                            $Plugins{$plugin_dir}{enabled} = 0;
1405                            next;
1406                        }
1407                        my $id = lc $plugin_dir;
1408                        $id =~ s/\.\w+$//;
1409                        my $p = $pclass->new(
1410                            {
1411                                id       => $id,
1412                                path     => $plugin_full_path,
1413                                envelope => $plugin_envelope
1414                            }
1415                        );
1416
1417                        # rebless? based on config?
1418                        local $plugin_sig = $plugin_dir;
1419                        MT->add_plugin($p);
1420                        $p->init_callbacks()
1421                            if $pclass eq 'MT::Plugin';
1422                        next;
1423                    }
1424
1425                    opendir SUBDIR, $plugin_full_path;
1426                    my @plugins = readdir SUBDIR;
1427                    closedir SUBDIR;
1428                    for my $plugin (@plugins) {
1429                        next if $plugin !~ /\.pl$/;
1430                        my $plugin_file =
1431                          File::Spec->catfile( $plugin_full_path, $plugin );
1432                        if ( -f $plugin_file ) {
1433                            $load_plugin->(
1434                                $plugin_file, $plugin_dir . '/' . $plugin
1435                            );
1436                        }
1437                    }
1438                }
1439            }
1440            closedir DH;
1441        }
1442    }
1443
1444    # Reset the Text_filters hash in case it was preloaded by plugins by
1445    # calling all_text_filters (Markdown in particular does this).
1446    # Upon calling all_text_filters again, it will be properly loaded by
1447    # querying the registry.
1448    %Text_filters = ();
1449
1450    1;
1451}
1452
1453my %addons;
1454
1455sub find_addons {
1456    my $mt = shift;
1457    my ($type) = @_;
1458
1459    unless (%addons) {
1460        my $addon_path = File::Spec->catdir( $MT_DIR, 'addons' );
1461        local *DH;
1462        if ( opendir DH, $addon_path ) {
1463            my @p = readdir DH;
1464            foreach my $p (@p) {
1465                next if $p eq '.' || $p eq '..';
1466                my $full_path = File::Spec->catdir( $addon_path, $p );
1467                if ( -d $full_path ) {
1468                    if ( $p =~ m/^(.+)\.(\w+)$/ ) {
1469                        my $label = $1;
1470                        my $id    = lc $1;
1471                        my $type  = $2;
1472                        if ( $type eq 'pack' ) {
1473                            $label .= ' Pack';
1474                        }
1475                        elsif ( $type eq 'theme' ) {
1476                            $label .= ' Theme';
1477                        }
1478                        elsif ( $type eq 'plugin' ) {
1479                            $label .= ' Plugin';
1480                        }
1481                        push @{ $addons{$type} },
1482                          {
1483                            label    => $label,
1484                            id       => $id,
1485                            envelope => 'addons/' . $p . '/',
1486                            path     => $full_path,
1487                          };
1488                    }
1489                }
1490            }
1491        }
1492    }
1493    if ($type) {
1494        my $addons = $addons{$type} ||= [];
1495        return $addons;
1496    }
1497    return 1;
1498}
1499
1500*mt_dir = \&server_path;
1501sub server_path { $_[0]->{mt_dir} }
1502sub app_dir     { $_[0]->{app_dir} }
1503sub config_dir  { $_[0]->{config_dir} }
1504
1505sub component {
1506    my $mt = shift;
1507    my ($id) = @_;
1508    return $Components{ lc $id };
1509}
1510
1511sub publisher {
1512    my $mt = shift;
1513    $mt = $mt->instance unless ref $mt;
1514    unless ( $mt->{WeblogPublisher} ) {
1515        require MT::WeblogPublisher;
1516        $mt->{WeblogPublisher} = new MT::WeblogPublisher();
1517    }
1518    $mt->{WeblogPublisher};
1519}
1520
1521sub rebuild {
1522    my $mt = shift;
1523    $mt->publisher->rebuild(@_)
1524      or return $mt->error( $mt->publisher->errstr );
1525}
1526
1527sub rebuild_entry {
1528    my $mt = shift;
1529    $mt->publisher->rebuild_entry(@_)
1530      or return $mt->error( $mt->publisher->errstr );
1531}
1532
1533sub rebuild_indexes {
1534    my $mt = shift;
1535    $mt->publisher->rebuild_indexes(@_)
1536      or return $mt->error( $mt->publisher->errstr );
1537}
1538
1539sub rebuild_archives {
1540    my $mt = shift;
1541    $mt->publisher->rebuild_archives(@_)
1542      or return $mt->error( $mt->publisher->errstr );
1543}
1544
1545sub ping {
1546    my $mt    = shift;
1547    my %param = @_;
1548    my $blog;
1549    require MT::Entry;
1550    require MT::Util;
1551    unless ( $blog = $param{Blog} ) {
1552        my $blog_id = $param{BlogID};
1553        $blog = MT::Blog->load($blog_id)
1554          or return $mt->trans_error( "Load of blog '[_1]' failed: [_2]",
1555            $blog_id, MT::Blog->errstr );
1556    }
1557
1558    my (@res);
1559
1560    my $send_updates = 1;
1561    if ( exists $param{OldStatus} ) {
1562        ## If this is a new entry (!$old_status) OR the status was previously
1563        ## set to draft, and is now set to publish, send the update pings.
1564        my $old_status = $param{OldStatus};
1565        if ( $old_status && $old_status eq MT::Entry::RELEASE() ) {
1566            $send_updates = 0;
1567        }
1568    }
1569
1570    if ( $send_updates && !( MT->config->DisableNotificationPings ) ) {
1571        ## Send update pings.
1572        my @updates = $mt->update_ping_list($blog);
1573        for my $url (@updates) {
1574            require MT::XMLRPC;
1575            if ( MT::XMLRPC->ping_update( 'weblogUpdates.ping', $blog, $url ) )
1576            {
1577                push @res, { good => 1, url => $url, type => "update" };
1578            }
1579            else {
1580                push @res,
1581                  {
1582                    good  => 0,
1583                    url   => $url,
1584                    type  => "update",
1585                    error => MT::XMLRPC->errstr
1586                  };
1587            }
1588        }
1589        if ( $blog->mt_update_key ) {
1590            require MT::XMLRPC;
1591            if ( MT::XMLRPC->mt_ping($blog) ) {
1592                push @res,
1593                  {
1594                    good => 1,
1595                    url  => $mt->{cfg}->MTPingURL,
1596                    type => "update"
1597                  };
1598            }
1599            else {
1600                push @res,
1601                  {
1602                    good  => 0,
1603                    url   => $mt->{cfg}->MTPingURL,
1604                    type  => "update",
1605                    error => MT::XMLRPC->errstr
1606                  };
1607            }
1608        }
1609    }
1610
1611    my $cfg     = $mt->{cfg};
1612    my $send_tb = $cfg->OutboundTrackbackLimit;
1613    return \@res if $send_tb eq 'off';
1614
1615    my @tb_domains;
1616    if ( $send_tb eq 'selected' ) {
1617        @tb_domains = $cfg->OutboundTrackbackDomains;
1618    }
1619    elsif ( $send_tb eq 'local' ) {
1620        my $iter = MT::Blog->load_iter();
1621        while ( my $b = $iter->() ) {
1622            next if $b->id == $blog->id;
1623            push @tb_domains, MT::Util::extract_domains( $b->site_url );
1624        }
1625    }
1626    my $tb_domains;
1627    if (@tb_domains) {
1628        $tb_domains = '';
1629        my %seen;
1630        local $_;
1631        foreach (@tb_domains) {
1632            next unless $_;
1633            $_ = lc($_);
1634            next if $seen{$_};
1635            $tb_domains .= '|' if $tb_domains ne '';
1636            $tb_domains .= quotemeta($_);
1637            $seen{$_} = 1;
1638        }
1639        $tb_domains = '(' . $tb_domains . ')' if $tb_domains;
1640    }
1641
1642    ## Send TrackBack pings.
1643    if ( my $entry = $param{Entry} ) {
1644        my $pings = $entry->to_ping_url_list;
1645
1646        my %pinged = map { $_ => 1 } @{ $entry->pinged_url_list };
1647        my $cats = $entry->categories;
1648        for my $cat (@$cats) {
1649            push @$pings, grep !$pinged{$_}, @{ $cat->ping_url_list };
1650        }
1651
1652        my $ua = MT->new_ua;
1653
1654        ## Build query string to be sent on each ping.
1655        my @qs;
1656        push @qs, 'title=' . MT::Util::encode_url( $entry->title );
1657        push @qs, 'url=' . MT::Util::encode_url( $entry->permalink );
1658        push @qs, 'excerpt=' . MT::Util::encode_url( $entry->get_excerpt );
1659        push @qs, 'blog_name=' . MT::Util::encode_url( $blog->name );
1660        my $qs = join '&', @qs;
1661
1662        ## Character encoding--best guess.
1663        my $enc = $mt->{cfg}->PublishCharset;
1664
1665        for my $url (@$pings) {
1666            $url =~ s/^\s*//;
1667            $url =~ s/\s*$//;
1668            my $url_domain;
1669            ($url_domain) = MT::Util::extract_domains($url);
1670            next if $tb_domains && lc($url_domain) !~ m/$tb_domains$/;
1671
1672            my $req = HTTP::Request->new( POST => $url );
1673            $req->content_type(
1674                "application/x-www-form-urlencoded; charset=$enc");
1675            $req->content($qs);
1676            my $res = $ua->request($req);
1677            if ( substr( $res->code, 0, 1 ) eq '2' ) {
1678                my $c = $res->content;
1679                my ( $error, $msg ) =
1680                  $c =~ m!<error>(\d+).*<message>(.+?)</message>!s;
1681                if ($error) {
1682                    push @res,
1683                      {
1684                        good  => 0,
1685                        url   => $url,
1686                        type  => 'trackback',
1687                        error => $msg
1688                      };
1689                }
1690                else {
1691                    push @res, { good => 1, url => $url, type => 'trackback' };
1692                }
1693            }
1694            else {
1695                push @res,
1696                  {
1697                    good  => 0,
1698                    url   => $url,
1699                    type  => 'trackback',
1700                    error => "HTTP error: " . $res->status_line
1701                  };
1702            }
1703        }
1704    }
1705    \@res;
1706}
1707
1708sub ping_and_save {
1709    my $mt    = shift;
1710    my %param = @_;
1711    if ( my $entry = $param{Entry} ) {
1712        my $results = MT::ping( $mt, @_ ) or return;
1713        my %still_ping;
1714        my $pinged = $entry->pinged_url_list;
1715        for my $res (@$results) {
1716            next if $res->{type} ne 'trackback';
1717            if ( !$res->{good} ) {
1718                $still_ping{ $res->{url} } = 1;
1719            }
1720            push @$pinged,
1721              $res->{url}
1722              . ( $res->{good}
1723                ? ''
1724                : ' ' . MT::I18N::encode_text( $res->{error} ) );
1725        }
1726        $entry->pinged_urls( join "\n", @$pinged );
1727        $entry->to_ping_urls( join "\n", keys %still_ping );
1728        $entry->save or return $mt->error( $entry->errstr );
1729        return $results;
1730    }
1731    1;
1732}
1733
1734sub needs_ping {
1735    my $mt    = shift;
1736    my %param = @_;
1737    my $blog  = $param{Blog};
1738    my $entry = $param{Entry};
1739    require MT::Entry;
1740    return unless $entry->status == MT::Entry::RELEASE();
1741    my $old_status = $param{OldStatus};
1742    my %list;
1743    ## If this is a new entry (!$old_status) OR the status was previously
1744    ## set to draft, and is now set to publish, send the update pings.
1745    if ( ( !$old_status || $old_status ne MT::Entry::RELEASE() )
1746        && !( MT->config->DisableNotificationPings ) )
1747    {
1748        my @updates = $mt->update_ping_list($blog);
1749        @list{@updates} = (1) x @updates;
1750        $list{ $mt->{cfg}->MTPingURL } = 1 if $blog && $blog->mt_update_key;
1751    }
1752    if ($entry) {
1753        @list{ @{ $entry->to_ping_url_list } } = ();
1754        my %pinged = map { $_ => 1 } @{ $entry->pinged_url_list };
1755        my $cats = $entry->categories;
1756        for my $cat (@$cats) {
1757            @list{ grep !$pinged{$_}, @{ $cat->ping_url_list } } = ();
1758        }
1759    }
1760    my @list = keys %list;
1761    return unless @list;
1762    \@list;
1763}
1764
1765sub update_ping_list {
1766    my $mt = shift;
1767    my ($blog) = @_;
1768
1769    my @updates;
1770    if ( my $pings = MT->registry('ping_servers') ) {
1771        my $up = $blog->update_pings;
1772        if ($up) {
1773            foreach ( split ',', $up ) {
1774                next unless exists $pings->{$_};
1775                push @updates, $pings->{$_}->{url};
1776            }
1777        }
1778    }
1779    if ( my $others = $blog->ping_others ) {
1780        push @updates, split /\r?\n/, $others;
1781    }
1782    my %updates;
1783    for my $url (@updates) {
1784        for ($url) {
1785            s/^\s*//;
1786            s/\s*$//;
1787        }
1788        next unless $url =~ /\S/;
1789        $updates{$url}++;
1790    }
1791    keys %updates;
1792}
1793
1794{
1795    my $LH;
1796
1797    sub set_language {
1798        my $pkg = shift;
1799        require MT::L10N;
1800        $LH = MT::L10N->get_handle(@_);
1801
1802        # Clear any l10n_handles in request
1803        $pkg->request( 'l10n_handle', {} );
1804        return $LH;
1805    }
1806
1807    require MT::I18N;
1808
1809    sub translate {
1810        my $this = shift;
1811        my $app = ref($this) ? $this : $this->app;
1812        if ( $app->{component} ) {
1813            if ( my $c = $app->component( $app->{component} ) ) {
1814                local $app->{component} = undef;
1815                return $c->translate(@_);
1816            }
1817        }
1818        my ( $format, @args ) = @_;
1819        foreach (@args) {
1820            $_ = $_->() if ref($_) eq 'CODE';
1821        }
1822        my $enc = MT->instance->config('PublishCharset') || 'utf-8';
1823        return $LH->maketext( $format, @args ) if $enc =~ m/utf-?8/i;
1824        $format = MT::I18N::encode_text( $format, $enc, 'utf-8' );
1825        MT::I18N::encode_text(
1826            $LH->maketext(
1827                $format,
1828                map { MT::I18N::encode_text( $_, $enc, 'utf-8' ) } @args
1829            ),
1830            'utf-8', $enc
1831        );
1832    }
1833
1834    sub translate_templatized {
1835        my $mt = shift;
1836        my $app = ref($mt) ? $mt : $mt->app;
1837        if ( $app->{component} ) {
1838            if ( my $c = $app->component( $app->{component} ) ) {
1839                local $app->{component} = undef;
1840                return $c->translate_templatized(@_);
1841            }
1842        }
1843        my @cstack;
1844        my ($text) = @_;
1845        while (1) {
1846            return '' unless $text;
1847            $text =~ s!(<(/)?(?:_|MT)_TRANS(_SECTION)?(?:(?:\s+((?:\w+)\s*=\s*(["'])(?:(<(?:[^"'>]|"[^"]*"|'[^']*')+)?>|[^\5]+?)*?\5))+?\s*/?)?>)!
1848            my($msg, $close, $section, %args) = ($1, $2, $3);
1849            while ($msg =~ /\b(\w+)\s*=\s*(["'])((?:<(?:[^"'>]|"[^"]*"|'[^']*')+?>|[^\2])*?)?\2/g) {  #"
1850                $args{$1} = $3;
1851            }
1852            if ($section) {
1853                if ($close) {
1854                    $mt = pop @cstack;
1855                } else {
1856                    if ($args{component}) {
1857                        push @cstack, $mt;
1858                        $mt = MT->component($args{component})
1859                            or die "Bad translation component: $args{component}";
1860                    }
1861                    else {
1862                        die "__trans_section without a component argument";
1863                    }
1864                }
1865                '';
1866            }
1867            else {
1868                $args{params} = '' unless defined $args{params};
1869                my @p = map MT::Util::decode_html($_),
1870                        split /\s*%%\s*/, $args{params}, -1;
1871                @p = ('') unless @p;
1872                my $translation = $mt->translate($args{phrase}, @p);
1873                if (exists $args{escape}) {
1874                    if (lc($args{escape}) eq 'html') {
1875                        $translation = MT::Util::encode_html($translation);
1876                    } elsif (lc($args{escape}) eq 'url') {
1877                        $translation = MT::Util::encode_url($translation);
1878                    } else {
1879                        # fallback for js/javascript/singlequotes
1880                        $translation = MT::Util::encode_js($translation);
1881                    }
1882                }
1883                $translation;
1884            }
1885            !igem or last;
1886        }
1887        return $text;
1888    }
1889
1890    sub current_language { $LH->language_tag }
1891    sub language_handle  { $LH }
1892
1893    sub charset {
1894        my $mt = shift;
1895        $mt->{charset} = shift if @_;
1896        return $mt->{charset} if $mt->{charset};
1897        $mt->{charset} = $mt->config->PublishCharset
1898          || $mt->language_handle->encoding;
1899    }
1900}
1901
1902sub supported_languages {
1903    my $mt = shift;
1904    require MT::L10N;
1905    require File::Basename;
1906    ## Determine full path to lib/MT/L10N directory...
1907    my $lib =
1908      File::Spec->catdir( File::Basename::dirname( $INC{'MT/L10N.pm'} ),
1909        'L10N' );
1910    ## ... From that, determine full path to extlib/MT/L10N.
1911    ## To do that, we look for the last instance of the string 'lib'
1912    ## in $lib and replace it with 'extlib'. reverse is a nice tricky
1913    ## way of doing that.
1914    ( my $extlib = reverse $lib ) =~ s!bil!biltxe!;
1915    $extlib = reverse $extlib;
1916    my @dirs = ( $lib, $extlib );
1917    my %langs;
1918    for my $dir (@dirs) {
1919        opendir DH, $dir or next;
1920        for my $f ( readdir DH ) {
1921            my ($tag) = $f =~ /^(\w+)\.pm$/;
1922            next unless $tag;
1923            my $lh = MT::L10N->get_handle($tag);
1924            $langs{ $lh->language_tag } = $lh->language_name;
1925        }
1926        closedir DH;
1927    }
1928    \%langs;
1929}
1930
1931# For your convenience
1932sub trans_error {
1933    my $app = shift;
1934    $app->error( $app->translate(@_) );
1935}
1936
1937sub all_text_filters {
1938    unless (%Text_filters) {
1939        if ( my $filters = MT->registry('text_filters') ) {
1940            %Text_filters = %$filters if ref($filters) eq 'HASH';
1941        }
1942    }
1943    if (my $enabled_filters = MT->config('AllowedTextFilters')) {
1944        my %enabled = map { $_ => 1 } split /\s*,\s*/, $enabled_filters;
1945        %Text_filters = map { $_ => $Text_filters{$_} }
1946                        grep { exists $enabled{$_} }
1947                        keys %Text_filters;
1948    }
1949    return \%Text_filters;
1950}
1951
1952sub apply_text_filters {
1953    my $mt = shift;
1954    my ( $str, $filters, @extra ) = @_;
1955    my $all_filters = $mt->all_text_filters;
1956    for my $filter (@$filters) {
1957        my $f = $all_filters->{$filter} or next;
1958        my $code = $f->{code} || $f->{handler};
1959        unless ( ref($code) eq 'CODE' ) {
1960            $code = $mt->handler_to_coderef($code);
1961            $f->{code} = $code;
1962        }
1963        if ( !$code ) {
1964            warn "Bad text filter: $filter";
1965            next;
1966        }
1967        $str = $code->( $str, @extra );
1968    }
1969    return $str;
1970}
1971
1972sub static_path {
1973    my $app = shift;
1974    my $spath = $app->config->StaticWebPath;
1975    if (!$spath) {
1976        $spath = $app->config->CGIPath;
1977        $spath .= '/' unless $spath =~ m!/$!;
1978        $spath .= 'mt-static/';
1979    } else {
1980        $spath .= '/' unless $spath =~ m!/$!;
1981    }
1982    $spath;
1983}
1984
1985sub static_file_path {
1986    my $app = shift;
1987    return $app->{__static_file_path}
1988        if exists $app->{__static_file_path};
1989
1990    my $path = $app->config('StaticFilePath');
1991    return $app->{__static_file_path} = $path if defined $path;
1992
1993    # Attempt to derive StaticFilePath based on environment
1994    my $web_path = $app->config->StaticWebPath || 'mt-static';
1995    $web_path =~ s!^https?://[^/]+/!!;
1996    if ($app->can('document_root')) {
1997        my $doc_static_path = File::Spec->catdir($app->document_root(), $web_path);
1998        return $app->{__static_file_path} = $doc_static_path
1999            if -d $doc_static_path;
2000    }
2001    my $mtdir_static_path = File::Spec->catdir($app->mt_dir, 'mt-static');
2002    return $app->{__static_file_path} = $mtdir_static_path
2003        if -d $mtdir_static_path;
2004    return;
2005}
2006
2007sub template_paths {
2008    my $mt = shift;
2009    my @paths;
2010    my $path = $mt->config->TemplatePath;
2011    if ($mt->{plugin_template_path}) {
2012        if (File::Spec->file_name_is_absolute($mt->{plugin_template_path})) {
2013            push @paths, $mt->{plugin_template_path}
2014                if -d $mt->{plugin_template_path};
2015        } else {
2016            my $dir = File::Spec->catdir($mt->app_dir,
2017                                         $mt->{plugin_template_path}); 
2018            if (-d $dir) {
2019                push @paths, $dir;
2020            } else {
2021                $dir = File::Spec->catdir($mt->mt_dir,
2022                                          $mt->{plugin_template_path});
2023                push @paths, $dir if -d $dir;
2024            }
2025        }
2026    }
2027    if (my $alt_path = $mt->config->AltTemplatePath) {
2028        if (-d $alt_path) {    # AltTemplatePath is absolute
2029            push @paths, File::Spec->catdir($alt_path,
2030                                            $mt->{template_dir})
2031                if $mt->{template_dir};
2032            push @paths, $alt_path;
2033        }
2034    }
2035 
2036    for my $addon ( @{ $mt->find_addons('pack') } ) {
2037        push @paths, File::Spec->catdir($addon->{path}, 'tmpl', $mt->{template_dir})
2038            if $mt->{template_dir};
2039        push @paths, File::Spec->catdir($addon->{path}, 'tmpl');
2040    }
2041
2042    push @paths, File::Spec->catdir($path, $mt->{template_dir})
2043        if $mt->{template_dir};
2044    push @paths, $path;
2045 
2046    return @paths;
2047}
2048
2049sub find_file {
2050    my $mt = shift;
2051    my ($paths, $file) = @_;
2052    my $filename;
2053    foreach my $p (@$paths) {
2054        my $filepath = File::Spec->canonpath(File::Spec->catfile($p, $file));
2055        $filename = File::Spec->canonpath($filepath);
2056        return $filename if -f $filename;
2057    }
2058    undef;
2059}
2060
2061sub load_global_tmpl {
2062    my $app = shift;
2063    my ( $arg, $blog_id ) = @_;
2064    $blog_id
2065        = $blog_id ? [ $blog_id, 0 ]
2066        : MT->app->blog ? [ MT->app->blog->id, 0 ]
2067        :                 0;
2068
2069    my $terms = {};
2070    if ( 'HASH' eq ref($arg) ) {
2071        $terms = { %$arg, blog_id => $blog_id };
2072    }
2073    else {
2074        $terms = {
2075            type => $arg,
2076            blog_id => $blog_id,
2077        }
2078    }
2079    my $args;
2080    if (ref $blog_id eq 'ARRAY') {
2081       $args->{sort} = 'blog_id';
2082       $args->{direction} = 'descend';
2083       $args->{limit} = 1;
2084    }
2085    require MT::Template;
2086    my $tmpl = MT::Template->load( $terms, $args);
2087    $app->set_default_tmpl_params($tmpl) if $tmpl;
2088    $tmpl;
2089}
2090
2091sub load_tmpl {
2092    my $mt = shift;
2093    if ( exists($mt->{component}) && ( $mt->{component} ne 'Core' ) ) {
2094        if (my $c = $mt->component($mt->{component})) {
2095            return $c->load_tmpl(@_);
2096        }
2097    }
2098
2099    my($file, @p) = @_;
2100    my $param;
2101    if (@p && (ref($p[$#p]) eq 'HASH')) {
2102        $param = pop @p;
2103    }
2104    my $cfg = $mt->config;
2105    require MT::Template;
2106    my $tmpl;
2107    my @paths = $mt->template_paths;
2108
2109    my $type = {'SCALAR' => 'scalarref', 'ARRAY' => 'arrayref'}->{ref $file}
2110        || 'filename';
2111    $tmpl = MT::Template->new(
2112        type => $type, source => $file,
2113        path => \@paths,
2114        filter => sub {
2115            my ($str, $fname) = @_;
2116            if ($fname) {
2117                $fname = File::Basename::basename($fname);
2118                $fname =~ s/\.tmpl$//;
2119                $mt->run_callbacks("template_source.$fname", $mt, @_);
2120            } else {
2121                $mt->run_callbacks("template_source", $mt, @_);
2122            }
2123            return $str;
2124        },
2125        @p);
2126    return $mt->error(
2127        $mt->translate("Loading template '[_1]' failed.", $file)) unless $tmpl;
2128    $mt->set_default_tmpl_params($tmpl);
2129    $tmpl->param($param) if $param;
2130    $tmpl;
2131}
2132
2133sub set_default_tmpl_params {
2134    my $mt = shift;
2135    my ($tmpl) = @_;
2136    my $param = {};
2137    $param->{mt_debug} = $MT::DebugMode;
2138    $param->{mt_beta} = 1 if MT->version_id =~ m/^\d+\.\d+(?:a|b|rc)/;
2139    $param->{static_uri} = $mt->static_path;
2140    $param->{mt_version} = MT->version_number;
2141    $param->{mt_version_id} = MT->version_id;
2142    $param->{mt_product_code} = MT->product_code;
2143    $param->{mt_product_name} = $mt->translate(MT->product_name);
2144    $param->{language_tag} = substr($mt->current_language, 0, 2);
2145    $param->{language_encoding} = $mt->charset;
2146    $param->{optimize_ui} = $mt->build_id && !$MT::DebugMode;
2147    if ($mt->isa('MT::App')) {
2148        if (my $author = $mt->user) {
2149            $param->{author_id} = $author->id;
2150            $param->{author_name} = $author->name;
2151        }
2152        ## We do this in load_tmpl because show_error and login don't call
2153        ## build_page; so we need to set these variables here.
2154        require MT::Auth;
2155        $param->{can_logout} = MT::Auth->can_logout;
2156        $param->{script_url} = $mt->uri;
2157        $param->{mt_url} = $mt->mt_uri;
2158        $param->{script_path} = $mt->path;
2159        $param->{script_full_url} = $mt->base . $mt->uri;
2160        $param->{agent_mozilla} = ( $ENV{HTTP_USER_AGENT} || '' ) =~ /gecko/i;
2161        $param->{agent_ie} = ( $ENV{HTTP_USER_AGENT} || '' ) =~ /\bMSIE\b/;
2162    }
2163    if (!$tmpl->param('template_filename')) {
2164        if (my $fname = $tmpl->{__file}) {
2165            $fname =~ s!\\!/!g;
2166            $fname =~ s/\.tmpl$//;
2167            $param->{template_filename} = $fname;
2168        }
2169    }
2170    $tmpl->param($param);
2171}
2172
2173sub process_mt_template {
2174    my $mt = shift;
2175    my ($body) = @_;
2176    $body =~ s@<(?:_|MT)_ACTION\s+mode="([^"]+)"(?:\s+([^>]*))?>@
2177        my $mode = $1; my %args;
2178        %args = $2 =~ m/\s*(\w+)="([^"]*?)"\s*/g if defined $2; # "
2179        MT::Util::encode_html($mt->uri(mode => $mode, args => \%args));
2180    @geis;
2181    # Strip out placeholder wrappers to facilitate tmpl_* callbacks
2182    $body =~ s/<\/?MT_(\w+):(\w+)>//g;
2183    $body;
2184}
2185
2186sub build_page {
2187    my $mt = shift;
2188    my($file, $param) = @_;
2189    my $tmpl;
2190    my $mode = $mt->mode;
2191    $param->{"mode_$mode"} ||= 1;
2192    $param->{breadcrumbs} = $mt->{breadcrumbs};
2193    if ($param->{breadcrumbs}[-1]) {
2194        $param->{breadcrumbs}[-1]{is_last} = 1;
2195        $param->{page_titles} = [ reverse @{ $mt->{breadcrumbs} } ];
2196    }
2197    pop @{ $param->{page_titles} };
2198    if (my $lang_id = $mt->current_language) {
2199        $param->{local_lang_id} ||= lc $lang_id;
2200    }
2201    $param->{magic_token} = $mt->current_magic if $mt->user;
2202
2203    # List of installed packs in the application footer
2204    my @packs_installed;
2205    my $packs = $mt->find_addons('pack');
2206    if ($packs) {
2207        foreach my $pack (@$packs) {
2208            my $c = $mt->component(lc $pack->{id});
2209            if ($c) {
2210                my $label = $c->label || $pack->{label};
2211                $label = $label->() if ref($label) eq 'CODE';
2212                # if the component did not declare a label,
2213                # it isn't wanting to be visible on the app footer.
2214                next if $label eq $c->{plugin_sig};
2215                push @packs_installed, {
2216                    label => $label,
2217                    version => $c->version,
2218                    id => $c->id,
2219                };
2220            }
2221        }
2222    }
2223    @packs_installed = sort { $a->{label} cmp $b->{label} } @packs_installed;
2224    $param->{packs_installed} = \@packs_installed;
2225   
2226    $param->{portal_url} = &portal_url;
2227
2228    for my $config_field (keys %{ MT::ConfigMgr->instance->{__var} || {} }) {
2229        $param->{ $config_field . '_readonly' } = 1;
2230    }
2231
2232    my $tmpl_file = '';
2233    if (UNIVERSAL::isa($file, 'MT::Template')) {
2234        $tmpl = $file;
2235        $tmpl_file = (exists $file->{__file}) ? $file->{__file} : '';
2236    } else {
2237        $tmpl = $mt->load_tmpl($file) or return;
2238        $tmpl_file = $file unless ref($file);
2239    }
2240
2241    if (($mode && ($mode !~ m/delete/)) && ($mt->{login_again} ||
2242        ($mt->{requires_login} && !$mt->user))) {
2243        ## If it's a login screen, direct the user to where they were going
2244        ## (query params including mode and all) unless they were logging in,
2245        ## logging out, or deleting something.
2246        my $q = $mt->{query};
2247        if ($mode) {
2248            my @query = map { { name => $_, value => scalar encode_text( $q->param($_) ) }; }
2249                grep { ($_ ne 'username') && ($_ ne 'password') && ($_ ne 'submit') && ($mode eq 'logout' ? ($_ ne '__mode') : 1) } $q->param;
2250            $param->{query_params} = \@query;
2251        }
2252        $param->{login_again} = $mt->{login_again};
2253    }
2254
2255    my $blog = $mt->blog;
2256    $tmpl->context()->stash('blog', $blog) if $blog;
2257
2258    $tmpl->param($param) if $param;
2259
2260    if ($tmpl_file) {
2261        $tmpl_file = File::Basename::basename($tmpl_file);
2262        $tmpl_file =~ s/\.tmpl$//;
2263        $tmpl_file = '.' . $tmpl_file;
2264    }
2265    $mt->run_callbacks('template_param' . $tmpl_file, $mt, $tmpl->param, $tmpl);
2266
2267    my $output = $mt->build_page_in_mem($tmpl);
2268    return unless defined $output;
2269
2270    $mt->run_callbacks('template_output' . $tmpl_file, $mt, \$output, $tmpl->param, $tmpl);
2271    return $output;
2272}
2273
2274sub build_page_in_mem {
2275    my $mt = shift;
2276    my($tmpl, $param) = @_;
2277    $tmpl->param($param) if $param;
2278    my $out = $tmpl->output;
2279    return $mt->error($tmpl->errstr) unless defined $out;
2280    return $mt->translate_templatized($mt->process_mt_template($out));
2281}
2282
2283sub new_ua {
2284    my $class = shift;
2285    my ($opt) = @_;
2286    $opt ||= {};
2287    my $lwp_class = 'LWP::UserAgent';
2288    if ($opt->{paranoid}) {
2289        eval { require LWPx::ParanoidAgent; };
2290        $lwp_class = 'LWPx::ParanoidAgent' unless $@;
2291    }
2292    eval "require $lwp_class;";
2293    return undef if $@;
2294    my $cfg = $class->config;
2295    my $max_size = exists $opt->{max_size} ? $opt->{max_size} : 100_000;
2296    my $timeout = exists $opt->{timeout} ? $opt->{timeout} : $cfg->HTTPTimeout || $cfg->PingTimeout;
2297    my $proxy = exists $opt->{proxy} ? $opt->{proxy} : $cfg->HTTPProxy || $cfg->PingProxy;
2298    my $no_proxy = exists $opt->{no_proxy} ? $opt->{no_proxy} : $cfg->HTTPNoProxy || $cfg->PingNoProxy;
2299    my $agent = $opt->{agent} || 'MovableType/' . $MT::VERSION;
2300    my $interface = exists $opt->{interface} ? $opt->{interface} : $cfg->HTTPInterface || $cfg->PingInterface;
2301
2302    if ( my $localaddr = $interface ) {
2303        @LWP::Protocol::http::EXTRA_SOCK_OPTS = (
2304            LocalAddr => $localaddr,
2305            Reuse     => 1
2306        );
2307    }
2308
2309    my $ua = $lwp_class->new;
2310    $ua->max_size($max_size) if (defined $max_size) && $ua->can('max_size');
2311    $ua->agent( $agent );
2312    $ua->timeout( $timeout ) if defined $timeout;
2313    if ( defined $proxy ) {
2314        $ua->proxy( http => $proxy );
2315        my @domains = split( /,\s*/, $no_proxy ) if $no_proxy;
2316        $ua->no_proxy(@domains) if @domains;
2317    }
2318    return $ua;
2319}
2320
2321sub build_email {
2322    my $class = shift;
2323    my ( $file, $param ) = @_;
2324    my $mt = $class->instance;
2325
2326    # basically, try to load from database
2327    my $blog = $param->{blog} || undef;
2328    my $id = $file;
2329    $id =~ s/(\.tmpl|\.mtml)$//;
2330
2331    require MT::Template;
2332    my @tmpl = MT::Template->load(
2333        {
2334            ( $blog ? ( blog_id => [ $blog->id, 0 ] ) : ( blog_id => 0 ) ),
2335            identifier => $id,
2336            type       => 'email',
2337        }
2338    );
2339    my $tmpl =
2340      @tmpl
2341      ? (
2342        scalar @tmpl > 1
2343        ? ( $tmpl[0]->blog_id ? $tmpl[0] : $tmpl[1] )
2344        : $tmpl[0]
2345      )
2346      : undef;
2347
2348    # try to load from file
2349    unless ($tmpl) {
2350        local $mt->{template_dir} = 'email';
2351        $tmpl = $mt->load_tmpl($file);
2352    }
2353    return unless $tmpl;
2354
2355    my $ctx = $tmpl->context;
2356    $ctx->stash( 'blog_id', $blog->id ) if $blog;
2357    $ctx->stash( 'blog',   delete $param->{'blog'} )   if $param->{'blog'};
2358    $ctx->stash( 'entry',  delete $param->{'entry'} )  if $param->{'entry'};
2359    $ctx->stash( 'author', delete $param->{'author'} ) if $param->{'author'};
2360    $ctx->stash( 'commenter', delete $param->{'commenter'} )
2361      if $param->{'commenter'};
2362    $ctx->stash( 'comment', delete $param->{'comment'} ) if $param->{'comment'};
2363    $ctx->stash( 'category', delete $param->{'category'} )
2364      if $param->{'category'};
2365    $ctx->stash( 'ping', delete $param->{'ping'} ) if $param->{'ping'};
2366
2367    foreach my $p (%$param) {
2368        if ( ref($p) ) {
2369            $tmpl->param( $p, $param->{$p} );
2370        }
2371    }
2372    return $mt->build_page_in_mem( $tmpl, $param );
2373}
2374
2375sub get_next_sched_post_for_user {
2376    my ( $author_id, @further_blog_ids ) = @_;
2377    require MT::Permission;
2378    my @perms = MT::Permission->load( { author_id => $author_id }, {} );
2379    my @blogs = @further_blog_ids;
2380    for my $perm (@perms) {
2381        next
2382          unless ( $perm->can_edit_config
2383            || $perm->can_publish_post
2384            || $perm->can_edit_all_posts );
2385        push @blogs, $perm->blog_id;
2386    }
2387    my $next_sched_utc = undef;
2388    require MT::Entry;
2389    for my $blog_id (@blogs) {
2390        my $blog           = MT::Blog->load($blog_id)
2391            or next;
2392        my $earliest_entry = MT::Entry->load(
2393            {
2394                status  => MT::Entry::FUTURE(),
2395                blog_id => $blog_id
2396            },
2397            { 'sort' => 'created_on' }
2398        );
2399        if ($earliest_entry) {
2400            my $entry_utc =
2401              MT::Util::ts2iso( $blog, $earliest_entry->created_on );
2402            if ( $entry_utc < $next_sched_utc || !defined($next_sched_utc) ) {
2403                $next_sched_utc = $entry_utc;
2404            }
2405        }
2406    }
2407    return $next_sched_utc;
2408}
2409
2410our %Commenter_Auth;
2411
2412sub init_commenter_authenticators {
2413    my $self = shift;
2414    my $auths = $self->registry("commenter_authenticators") || {};
2415    %Commenter_Auth = %$auths;
2416    my $app = $self->app;
2417    my $blog = $app->blog if $app->isa('MT::App');
2418    foreach my $auth ( keys %$auths ) {
2419        if ( my $c = $auths->{$auth}->{condition} ) {
2420            $c = $self->handler_to_coderef($c);
2421            if ( $c ) {
2422                delete $Commenter_Auth{$auth} unless $c->($blog);
2423            }
2424        }
2425    }
2426    $Commenter_Auth{$_}{key} ||= $_ for keys %Commenter_Auth;
2427} 
2428
2429sub commenter_authenticator {
2430    my $self = shift;
2431    my ($key) = @_;
2432    %Commenter_Auth or $self->init_commenter_authenticators();
2433    return $Commenter_Auth{$key};
2434}
2435
2436sub commenter_authenticators {
2437    my $self = shift;
2438    %Commenter_Auth or $self->init_commenter_authenticators();
2439    return values %Commenter_Auth;
2440}
2441
2442sub _commenter_auth_params {
2443    my ( $key, $blog_id, $entry_id, $static ) = @_;
2444    my $params = {
2445        blog_id => $blog_id,
2446        static  => $static,
2447    };
2448    $params->{entry_id} = $entry_id if defined $entry_id;
2449    return $params;
2450}
2451
2452sub _openid_commenter_condition {
2453    eval "require Digest::SHA1;";
2454    return $@ ? 0 : 1;
2455}
2456
2457sub core_commenter_authenticators {
2458    return {
2459        'OpenID' => {
2460            class      => 'MT::Auth::OpenID',
2461            label      => 'OpenID',
2462            login_form => <<OpenID,
2463<form method="post" action="<mt:var name="script_url">">
2464<input type="hidden" name="__mode" value="login_external" />
2465<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2466<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2467<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2468<fieldset>
2469<mtapp:setting
2470    id="openid_display"
2471    label="<__trans phrase="OpenID URL">"
2472    hint="<__trans phrase="Sign in using your OpenID identity.">">
2473<input type="hidden" name="key" value="OpenID" />
2474<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%;" />
2475    <p class="hint"><__trans phrase="OpenID is an open and decentralized single sign-on identity system."></p>
2476</mtapp:setting>
2477<img src="<mt:var name="static_uri">images/comment/openid_enabled.png" class="right" />
2478<div class="actions-bar actions-bar-login">
2479    <div class="actions-bar-inner pkg actions">
2480        <button
2481            type="submit"
2482            class="primary-button"
2483            ><__trans phrase="Sign in"></button>
2484    </div>
2485</div>
2486<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>
2487</fieldset>
2488</form>
2489OpenID
2490            login_form_params => \&_commenter_auth_params,
2491            condition         => \&_openid_commenter_condition,
2492            logo              => 'images/comment/signin_openid.png',
2493            logo_small        => 'images/comment/openid_logo.png',
2494            order => 10,
2495        },
2496        'LiveJournal' => {
2497            class      => 'MT::Auth::LiveJournal',
2498            label      => 'LiveJournal',
2499            login_form => <<LiveJournal,
2500<form method="post" action="<mt:var name="script_url">">
2501<input type="hidden" name="__mode" value="login_external" />
2502<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2503<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2504<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2505<input type="hidden" name="key" value="LiveJournal" />
2506<fieldset>
2507<mtapp:setting
2508    id="livejournal_display"
2509    label="<__trans phrase="Your LiveJournal Username">">
2510<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%;" />
2511</mtapp:setting>
2512<div class="actions-bar actions-bar-login">
2513    <div class="actions-bar-inner pkg actions">
2514        <button
2515            type="submit"
2516            class="primary-button"
2517            ><__trans phrase="Sign in"></button>
2518    </div>
2519</div>
2520<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>
2521</fieldset>
2522</form>
2523LiveJournal
2524            login_form_params => \&_commenter_auth_params,
2525            condition         => \&_openid_commenter_condition,
2526            logo              => 'images/comment/signin_livejournal.png',
2527            logo_small        => 'images/comment/livejournal_logo.png',
2528            order => 11,
2529        },
2530        'Vox' => {
2531            class      => 'MT::Auth::Vox',
2532            label      => 'Vox',
2533            login_form => <<Vox,
2534<form method="post" action="<mt:var name="script_url">">
2535<input type="hidden" name="__mode" value="login_external" />
2536<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2537<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2538<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2539<input type="hidden" name="key" value="Vox" />
2540<fieldset>
2541<mtapp:setting
2542    id="vox_display"
2543    label="<__trans phrase="Your Vox Blog URL">">
2544http:// <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
2545</mtapp:setting>
2546<div class="actions-bar actions-bar-login">
2547    <div class="actions-bar-inner pkg actions">
2548        <button
2549            type="submit"