root/trunk/lib/MT.pm

Revision 4155, 133.0 kB (checked in by fumiakiy, 3 months ago)

Merged slapshot to trunk. "svn merge -r3786:4152 http://code.sixapart.com/svn/movabletype/branches/slapshot/ ."
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|summary)$/) {
313            my $ppkg = $pkg->model($1);
314            my $mpkg = $ppkg->meta_pkg($2);
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) if $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    unless ($mt->{cfg_file}) {
831        my $cfg_file = $mt->find_config($param);
832
833        return $mt->error(
834            "Missing configuration file. Maybe you forgot to move mt-config.cgi-original to mt-config.cgi?"
835        ) unless $cfg_file;
836        $cfg_file = File::Spec->rel2abs($cfg_file);
837        $mt->{cfg_file} = $cfg_file;
838    }
839
840    # translate the config file's location to an absolute path, so we
841    # can use that directory as a basis for calculating other relative
842    # paths found in the config file.
843    my $config_dir = $mt->{config_dir} = dirname($mt->{cfg_file});
844
845    # store the mt_dir (home) as an absolute path; fallback to the config
846    # directory if it isn't set.
847    $mt->{mt_dir} =
848      $param->{Directory}
849      ? File::Spec->rel2abs( $param->{Directory} )
850      : $mt->{config_dir};
851    $mt->{mt_dir} ||= dirname($0);
852
853    # also make note of the active application path; this is derived by
854    # checking the PWD environment variable, the dirname of $0,
855    # the directory of SCRIPT_FILENAME and lastly, falls back to mt_dir
856    unless ($mt->{app_dir}) {
857        $mt->{app_dir} = $ENV{PWD} || "";
858        $mt->{app_dir} = dirname($0)
859          if !$mt->{app_dir}
860          || !File::Spec->file_name_is_absolute( $mt->{app_dir} );
861        $mt->{app_dir} = dirname( $ENV{SCRIPT_FILENAME} )
862          if $ENV{SCRIPT_FILENAME}
863          && ( !$mt->{app_dir}
864            || ( !File::Spec->file_name_is_absolute( $mt->{app_dir} ) ) );
865        $mt->{app_dir} ||= $mt->{mt_dir};
866        $mt->{app_dir} = File::Spec->rel2abs( $mt->{app_dir} );
867    }
868
869    my $cfg = $mt->config;
870    $cfg->define( $mt->registry('config_settings') );
871    $cfg->read_config($mt->{cfg_file}) or return $mt->error( $cfg->errstr );
872   
873    my @mt_paths = $cfg->paths;
874    for my $meth (@mt_paths) {
875        my $path = $cfg->get( $meth, undef );
876        my $type = $cfg->type($meth);
877        if ( defined $path ) {
878            if ( $type eq 'ARRAY' ) {
879                my @paths = $cfg->get($meth);
880                local $_;
881                foreach (@paths) {
882                    next if File::Spec->file_name_is_absolute($_);
883                    $_ = File::Spec->catfile( $config_dir, $_ );
884                }
885                $cfg->$meth( \@paths );
886            }
887            else {
888                next if ref($path); # unexpected referene, ignore
889                if ( !File::Spec->file_name_is_absolute($path) ) {
890                    $path = File::Spec->catfile( $config_dir, $path );
891                    $cfg->$meth($path);
892                }
893            }
894        }
895        else {
896            next if $type eq 'ARRAY';
897            my $path = $cfg->default($meth);
898            if ( defined $path ) {
899                $cfg->$meth( File::Spec->catfile( $config_dir, $path ) );
900            }
901        }
902    }
903
904    return $mt->trans_error("Bad ObjectDriver config")
905      unless $cfg->ObjectDriver;
906
907    if ($cfg->PerformanceLogging && $cfg->ProcessMemoryCommand) {
908        $mt->log_times();
909    }
910
911    $mt->set_language( $cfg->DefaultLanguage );
912
913    my $cgi_path = $cfg->CGIPath;
914    if ( !$cgi_path || $cgi_path =~ m!http://www\.example\.com/! ) {
915        return $mt->trans_error("Bad CGIPath config");
916    }
917
918    $mt->{cfg} = $cfg;
919
920    1;
921}
922
923{
924my ($memory_start);
925sub log_times {
926    my $pkg = shift;
927
928    my $timer = $pkg->get_timer;
929    return unless $timer;
930
931    my $memory;
932    my $cmd = $pkg->config->ProcessMemoryCommand;
933    if ($cmd) {
934        my $re;
935        if (ref($cmd) eq 'HASH') {
936            $re = $cmd->{regex};
937            $cmd = $cmd->{command};
938        }
939        $cmd =~ s/\$\$/$$/g;
940        $memory = `$cmd`;
941        if ($re) {
942            if ($memory =~ m/$re/) {
943                $memory = $1;
944                $memory =~ s/\D//g;
945            }
946        } else {
947            $memory =~ s/\s+//gs;
948        }
949    }
950
951    # Called at the start of the process; so we're only recording
952    # the memory usage at the start of the app right now.
953    unless ($timer->{elapsed}) {
954        $memory_start = $memory;
955        return;
956    }
957
958    require File::Spec;
959    my $dir = MT->config('PerformanceLoggingPath') or return;
960
961    my @time = localtime(time);
962    my $file = sprintf("pl-%04d%02d%02d.log", $time[5] + 1900, $time[4]+1, $time[3]);
963    my $log_file = File::Spec->catfile( $dir, $file );
964
965    my $first_write = ! -f $log_file;
966
967    local *PERFLOG;
968    open PERFLOG, ">>$log_file";
969    require Fcntl;
970    flock(PERFLOG, Fcntl::LOCK_EX());
971
972    if ($first_write) {
973        require Config;
974        my ($osname, $osvers) = ($Config::Config{osname}, $Config::Config{osvers});
975        print PERFLOG "# Operating System: $osname/$osvers\n";
976        print PERFLOG "# Platform: $^O\n";
977        my $ver = ref($^V) eq 'version' ? $^V->normal : ( $^V ? join('.', unpack 'C*', $^V) : $] );
978        print PERFLOG "# Perl Version: $ver\n";
979        print PERFLOG "# Web Server: $ENV{SERVER_SOFTWARE}\n";
980        require MT::Object;
981        my $driver = MT::Object->driver;
982        if ($driver) {
983            my $dbh = $driver->r_handle;
984            if ($dbh) {
985                my $dbname = $dbh->get_info( 17 ); # SQL_DBMS_NAME
986                my $dbver = $dbh->get_info( 18 ); # SQL_DBMS_VER
987                if ($dbname && $dbver) {
988                    print PERFLOG "# Database: $dbname/$dbver\n";
989                }
990            }
991        }
992        my ($drname, $drh) = each %DBI::installed_drh;
993        print PERFLOG "# Database Library: DBI/" . $DBI::VERSION . "; DBD/" . $drh->{Version} . "\n";
994        if ($ENV{MOD_PERL}) {
995            print PERFLOG "# App Mode: mod_perl\n";
996        }
997        elsif ($ENV{FAST_CGI}) {
998            print PERFLOG "# App Mode: FastCGI\n";
999        }
1000        else {
1001            print PERFLOG "# App Mode: CGI\n";
1002        }
1003    }
1004
1005    if ($memory) {
1006        print PERFLOG $timer->dump_line("mem_start=$memory_start", "mem_end=$memory");
1007    } else {
1008        print PERFLOG $timer->dump_line();
1009    }
1010
1011    close PERFLOG;
1012}
1013}
1014
1015sub get_timer {
1016    my $mt = shift;
1017    $mt = MT->instance unless ref $mt;
1018    my $timer = $mt->request('timer');
1019    unless (defined $timer) {
1020        if (MT->config('PerformanceLogging')) {
1021            my $uri;
1022            if ($mt->isa('MT::App')) {
1023                $uri = $mt->uri( args => { $mt->param_hash } );
1024            }
1025            require MT::Util::ReqTimer;
1026            $timer = MT::Util::ReqTimer->new( $uri );
1027        } else {
1028            $timer = 0;
1029        }
1030        $mt->request('timer', $timer);
1031    }
1032    return $timer;
1033}
1034
1035sub time_this {
1036    my $mt = shift;
1037    my ($str, $code) = @_;
1038    my $timer = $mt->get_timer();
1039    my $ret;
1040    if ($timer) {
1041        $timer->pause_partial();
1042        $ret = $code->();
1043        $timer->mark($str);
1044    } else {
1045        $ret = $code->();
1046    }
1047    return $ret;
1048}
1049
1050sub init_config_from_db {
1051    my $mt = shift;
1052    my ($param) = @_;
1053    my $cfg = $mt->config;
1054
1055    # Tell any instantiated drivers to reconfigure themselves as necessary
1056    require MT::ObjectDriverFactory;
1057    if (MT->config('ObjectDriver')) {
1058        my $driver = MT::ObjectDriverFactory->instance;
1059        $driver->configure if $driver;
1060    } else {
1061        MT::ObjectDriverFactory->configure();
1062    }
1063
1064    $cfg->read_config_db();
1065
1066    1;
1067}
1068
1069sub bootstrap {
1070    my $pkg = shift;
1071    $pkg->init_paths() or return;
1072    $pkg->init_core()  or return;
1073}
1074
1075sub init_paths {
1076    my $mt = shift;
1077    my ($param) = @_;
1078
1079    # determine MT directory
1080    my ($orig_dir);
1081    require File::Spec;
1082    if ( !( $MT_DIR = $ENV{MT_HOME} ) ) {
1083        if ( $0 =~ m!(.*([/\\]))! ) {
1084            $orig_dir = $MT_DIR = $1;
1085            my $slash = $2;
1086            $MT_DIR =~ s!(?:[/\\]|^)(?:plugins[/\\].*|tools[/\\])$!$slash!;
1087            $MT_DIR = '' if ( $MT_DIR =~ m!^\.?[\\/]$! );
1088        }
1089        else {
1090
1091            # MT_DIR/lib/MT.pm -> MT_DIR/lib -> MT_DIR
1092            $MT_DIR = dirname( dirname( File::Spec->rel2abs(__FILE__) ) );
1093        }
1094        unless ($MT_DIR) {
1095            $orig_dir = $MT_DIR = $ENV{PWD} || '.';
1096            $MT_DIR =~ s!(?:[/\\]|^)(?:plugins[/\\].*|tools[/\\]?)$!!;
1097        }
1098        $ENV{MT_HOME} = $MT_DIR;
1099    }
1100    unshift @INC, File::Spec->catdir( $MT_DIR,   'extlib' );
1101    unshift @INC, File::Spec->catdir( $orig_dir, 'lib' )
1102      if $orig_dir && ( $orig_dir ne $MT_DIR );
1103
1104    $mt->set_language('en_US');
1105
1106    if ( my $cfg_file = $mt->find_config($param) ) {
1107        $cfg_file = File::Spec->rel2abs($cfg_file);
1108        $CFG_FILE = $cfg_file;
1109    }
1110    else {
1111        return $mt->trans_error(
1112"Missing configuration file. Maybe you forgot to move mt-config.cgi-original to mt-config.cgi?"
1113        ) if ref($mt);
1114    }
1115
1116    # store the mt_dir (home) as an absolute path; fallback to the config
1117    # directory if it isn't set.
1118    $MT_DIR ||=
1119      $param->{directory}
1120      ? File::Spec->rel2abs( $param->{directory} )
1121      : $CFG_DIR;
1122    $MT_DIR ||= dirname($0);
1123
1124    # also make note of the active application path; this is derived by
1125    # checking the PWD environment variable, the dirname of $0,
1126    # the directory of SCRIPT_FILENAME and lastly, falls back to mt_dir
1127    $APP_DIR = $ENV{PWD} || "";
1128    $APP_DIR = dirname($0)
1129      if !$APP_DIR || !File::Spec->file_name_is_absolute($APP_DIR);
1130    $APP_DIR = dirname( $ENV{SCRIPT_FILENAME} )
1131      if $ENV{SCRIPT_FILENAME}
1132      && ( !$APP_DIR || ( !File::Spec->file_name_is_absolute($APP_DIR) ) );
1133    $APP_DIR ||= $MT_DIR;
1134    $APP_DIR = File::Spec->rel2abs($APP_DIR);
1135
1136    return 1;
1137}
1138
1139sub init_core {
1140    my $mt = shift;
1141    return if exists $Components{'core'};
1142    require MT::Core;
1143    my $c = MT::Core->new( { id => 'core', path => $MT_DIR } )
1144      or die MT::Core->errstr;
1145    $Components{'core'} = $c;
1146
1147    push @Components, $c;
1148    return 1;
1149}
1150
1151sub init_lang_defaults {
1152    my $mt = shift;
1153    my $cfg = $mt->config;
1154   
1155    $cfg->DefaultLanguage('en_US') unless $cfg->DefaultLanguage;
1156   
1157    my %lang_settings = (
1158        'NewsboxURL'         => 'NEWSBOX_URL',
1159        'LearningNewsURL'    => 'LEARNINGNEWS_URL',
1160        'SupportURL'         => 'SUPPORT_URL',
1161        'NewsURL'            => 'NEWS_URL',
1162        'DefaultTimezone'    => 'DEFAULT_TIMEZONE',
1163        'TimeOffset'         => 'DEFAULT_TIMEZONE',
1164        'MailEncoding'       => 'MAIL_ENCODING',
1165        'ExportEncoding'     => 'EXPORT_ENCODING',
1166        'LogExportEncoding'  => 'LOG_EXPORT_ENCODING',
1167        'CategoryNameNodash' => 'CATEGORY_NAME_NODASH',
1168        'PublishCharset'     => 'PUBLISH_CHARSET'
1169    );
1170
1171    require MT::I18N;
1172    foreach my $setting (keys %lang_settings) {
1173        my $const = $lang_settings{$setting};
1174        my $value = $cfg->$setting;
1175        my $i18n_val = MT::I18N::const($const);
1176        if ( !$value ) {
1177            $cfg->$setting($i18n_val);
1178        }
1179        elsif ( ( $value eq $cfg->default($setting) )
1180             && ( $value ne $i18n_val ) ) {
1181            $cfg->$setting($i18n_val);
1182        }
1183    }
1184   
1185    return 1;
1186}
1187
1188sub init {
1189    my $mt    = shift;
1190    my %param = @_;
1191
1192    $mt->bootstrap() unless $MT_DIR;
1193    $mt->{mt_dir}     = $MT_DIR;
1194    $mt->{config_dir} = $CFG_DIR;
1195    $mt->{app_dir}    = $APP_DIR;
1196
1197    $mt->init_callbacks();
1198
1199    ## Initialize the language to the default in case any errors occur in
1200    ## the rest of the initialization process.
1201    $mt->init_config( \%param ) or return;
1202    $mt->init_lang_defaults(@_) or return;
1203    require MT::Plugin;
1204    $mt->init_addons(@_)        or return;
1205    $mt->init_config_from_db( \%param ) or return;
1206    $mt->init_debug_mode;
1207    $mt->init_plugins(@_)       or return;
1208    $plugins_installed = 1;
1209    $mt->init_schema();
1210    $mt->init_permissions();
1211
1212    # Load MT::Log so constants are available
1213    require MT::Log;
1214
1215    $mt->run_callbacks('post_init', $mt, \%param);
1216    return $mt;
1217}
1218
1219sub init_debug_mode {
1220    my $mt = shift;
1221    my $cfg = $mt->config;
1222
1223    # init the debug mode
1224    if ( $MT::DebugMode = $cfg->DebugMode ) {
1225        require Data::Dumper;
1226        $Data::Dumper::Terse    = 1;
1227        $Data::Dumper::Maxdepth = 4;
1228        $Data::Dumper::Sortkeys = 1;
1229        $Data::Dumper::Indent   = 1;
1230    }
1231}
1232
1233sub init_callbacks {
1234    my $mt = shift;
1235    MT->_register_core_callbacks({
1236        'build_file_filter' => sub { MT->publisher->queue_build_file_filter(@_) },
1237        'cms_upload_file' => \&core_upload_file_to_sync,
1238        'api_upload_file' => \&core_upload_file_to_sync,
1239        'post_init' => '$Core::MT::Summary::Triggers::post_init_add_triggers',
1240    });
1241}
1242
1243sub core_upload_file_to_sync {
1244    my ($cb, %args) = @_;
1245    MT->upload_file_to_sync(%args);
1246}
1247
1248sub upload_file_to_sync {
1249    my $class = shift;
1250    my (%args) = @_;
1251
1252    # no need to do this unless we're syncing stuff.
1253    return unless MT->config('SyncTarget');
1254
1255    my $url = $args{url};
1256    my $file = $args{file};
1257    return unless -f $file;
1258
1259    my $blog = $args{blog};
1260    my $blog_id = $blog->id;
1261    return unless $blog->publish_queue;
1262
1263    require MT::FileInfo;
1264    my $base_url = $url;
1265    $base_url =~ s!^https?://[^/]+!!;
1266    my $fi = MT::FileInfo->load({ blog_id => $blog_id, url => $base_url });
1267    if (!$fi) {
1268        $fi = new MT::FileInfo;
1269        $fi->blog_id($blog_id);
1270        $fi->url($base_url);
1271        $fi->file_path($file);
1272    } else {
1273        $fi->file_path($file);
1274    }
1275    $fi->save;
1276
1277    require MT::TheSchwartz;
1278    require TheSchwartz::Job;
1279    my $job = TheSchwartz::Job->new();
1280    $job->funcname('MT::Worker::Sync');
1281    $job->uniqkey( $fi->id );
1282    $job->coalesce( ( $fi->blog_id || 0 ) . ':' . $$ . ':' . ( time - ( time % 10 ) ) );
1283    MT::TheSchwartz->insert($job);
1284}
1285
1286sub init_addons {
1287    my $mt = shift;
1288    my $cfg = $mt->config;
1289    my @PluginPaths;
1290
1291    unshift @PluginPaths, File::Spec->catdir( $MT_DIR, 'addons' );
1292    return $mt->_init_plugins_core({}, 1, \@PluginPaths);
1293}
1294
1295sub init_plugins {
1296    my $mt = shift;
1297
1298    # Load compatibility module for prior version
1299    # This should always be MT::Compat::v(MAJOR_RELEASE_VERSION - 1).
1300    require MT::Compat::v3;
1301
1302    my $cfg          = $mt->config;
1303    my $use_plugins  = $cfg->UsePlugins;
1304    my @PluginPaths  = $cfg->PluginPath;
1305    my $PluginSwitch = $cfg->PluginSwitch || {};
1306    return $mt->_init_plugins_core($PluginSwitch, $use_plugins, \@PluginPaths);
1307}
1308
1309sub _init_plugins_core {
1310    my $mt = shift;
1311    my ($PluginSwitch, $use_plugins, $PluginPaths) = @_;
1312
1313    my $timer;
1314    if ($mt->config->PerformanceLogging) {
1315        $timer = $mt->get_timer();
1316    }
1317
1318    foreach my $PluginPath (@$PluginPaths) {
1319        my $plugin_lastdir = $PluginPath;
1320        $plugin_lastdir =~ s![\\/]$!!;
1321        $plugin_lastdir =~ s!.*[\\/]!!;
1322        local *DH;
1323        if ( opendir DH, $PluginPath ) {
1324            my @p = readdir DH;
1325          PLUGIN:
1326            for my $plugin (@p) {
1327                next if ( $plugin =~ /^\.\.?$/ || $plugin =~ /~$/ );
1328
1329                my $load_plugin = sub {
1330                    my ( $plugin, $sig ) = @_;
1331                    die "Bad plugin filename '$plugin'"
1332                      if ( $plugin !~ /^([-\\\/\@\:\w\.\s~]+)$/ );
1333                    local $plugin_sig      = $sig;
1334                    local $plugin_registry = {};
1335                    $plugin = $1;
1336                    if (
1337                        !$use_plugins
1338                        || ( exists $PluginSwitch->{$plugin_sig}
1339                            && !$PluginSwitch->{$plugin_sig} )
1340                      )
1341                    {
1342                        $Plugins{$plugin_sig}{full_path} = $plugin_full_path;
1343                        $Plugins{$plugin_sig}{enabled}   = 0;
1344                        return 0;
1345                    }
1346                    return 0 if exists $Plugins{$plugin_sig};
1347                    $Plugins{$plugin_sig}{full_path} = $plugin_full_path;
1348                    $timer->pause_partial if $timer;
1349                    eval "# line " . __LINE__ . " " . __FILE__ . "\nrequire '$plugin';";
1350                    $timer->mark("Loaded plugin " . $sig) if $timer;
1351                    if ($@) {
1352                        $Plugins{$plugin_sig}{error} = $@;
1353                        # Issue MT log within another eval block in the
1354                        # event that the plugin error is happening before
1355                        # the database has been initialized...
1356                        eval {
1357                            # line __LINE__ __FILE__
1358                            require MT::Log;
1359                            $mt->log(
1360                                {
1361                                    message => $mt->translate(
1362                                        "Plugin error: [_1] [_2]", $plugin,
1363                                        $Plugins{$plugin_sig}{error}
1364                                    ),
1365                                    class => 'system',
1366                                    level => MT::Log::ERROR()
1367                                }
1368                            );
1369                        };
1370                        return 0;
1371                    }
1372                    else {
1373                        if ( my $obj = $Plugins{$plugin_sig}{object} ) {
1374                            $obj->init_callbacks();
1375                        }
1376                        else {
1377
1378                            # A plugin did not register itself, so
1379                            # create a dummy plugin object which will
1380                            # cause it to show up in the plugin listing
1381                            # by it's filename.
1382                            MT->add_plugin( {} );
1383                        }
1384                    }
1385                    $Plugins{$plugin_sig}{enabled} = 1;
1386                    return 1;
1387                };
1388                $plugin_full_path = File::Spec->catfile( $PluginPath, $plugin );
1389                if ( -f $plugin_full_path ) {
1390                    $plugin_envelope = $plugin_lastdir;
1391                    $load_plugin->( $plugin_full_path, $plugin )
1392                      if $plugin_full_path =~ /\.pl$/;
1393                }
1394                else {
1395                    my $plugin_dir = $plugin;
1396                    $plugin_envelope = "$plugin_lastdir/" . $plugin;
1397
1398                    # handle config.yaml
1399                    my $yaml =
1400                      File::Spec->catdir( $plugin_full_path, 'config.yaml' );
1401
1402                    foreach my $lib (qw(lib extlib)) {
1403                        my $plib = File::Spec->catdir( $plugin_full_path, $lib );
1404                        unshift @INC, $plib if -d $plib;
1405                    }
1406
1407                    if ( -f $yaml ) {
1408                        my $pclass =
1409                          $plugin_dir =~ m/\.pack$/
1410                          ? 'MT::Component'
1411                          : 'MT::Plugin';
1412
1413                        # Don't process disabled plugin config.yaml files.
1414                        if (
1415                            $pclass eq 'MT::Plugin'
1416                            && (
1417                                !$use_plugins
1418                                || ( exists $PluginSwitch->{$plugin_dir}
1419                                    && !$PluginSwitch->{$plugin_dir} )
1420                            )
1421                          )
1422                        {
1423                            $Plugins{$plugin_dir}{full_path} =
1424                              $plugin_full_path;
1425                            $Plugins{$plugin_dir}{enabled} = 0;
1426                            next;
1427                        }
1428                        next if exists $Plugins{$plugin_dir};
1429                        my $id = lc $plugin_dir;
1430                        $id =~ s/\.\w+$//;
1431                        my $p = $pclass->new(
1432                            {
1433                                id       => $id,
1434                                path     => $plugin_full_path,
1435                                envelope => $plugin_envelope
1436                            }
1437                        );
1438
1439                        # rebless? based on config?
1440                        local $plugin_sig = $plugin_dir;
1441                        MT->add_plugin($p);
1442                        $p->init_callbacks();
1443                        next;
1444                    }
1445
1446                    opendir SUBDIR, $plugin_full_path;
1447                    my @plugins = readdir SUBDIR;
1448                    closedir SUBDIR;
1449                    for my $plugin (@plugins) {
1450                        next if $plugin !~ /\.pl$/;
1451                        my $plugin_file =
1452                          File::Spec->catfile( $plugin_full_path, $plugin );
1453                        if ( -f $plugin_file ) {
1454                            $load_plugin->(
1455                                $plugin_file, $plugin_dir . '/' . $plugin
1456                            );
1457                        }
1458                    }
1459                }
1460            }
1461            closedir DH;
1462        }
1463    }
1464
1465    # Reset the Text_filters hash in case it was preloaded by plugins by
1466    # calling all_text_filters (Markdown in particular does this).
1467    # Upon calling all_text_filters again, it will be properly loaded by
1468    # querying the registry.
1469    %Text_filters = ();
1470
1471    1;
1472}
1473
1474my %addons;
1475
1476sub find_addons {
1477    my $mt = shift;
1478    my ($type) = @_;
1479
1480    unless (%addons) {
1481        my $addon_path = File::Spec->catdir( $MT_DIR, 'addons' );
1482        local *DH;
1483        if ( opendir DH, $addon_path ) {
1484            my @p = readdir DH;
1485            foreach my $p (@p) {
1486                next if $p eq '.' || $p eq '..';
1487                my $full_path = File::Spec->catdir( $addon_path, $p );
1488                if ( -d $full_path ) {
1489                    if ( $p =~ m/^(.+)\.(\w+)$/ ) {
1490                        my $label = $1;
1491                        my $id    = lc $1;
1492                        my $type  = $2;
1493                        if ( $type eq 'pack' ) {
1494                            $label .= ' Pack';
1495                        }
1496                        elsif ( $type eq 'theme' ) {
1497                            $label .= ' Theme';
1498                        }
1499                        elsif ( $type eq 'plugin' ) {
1500                            $label .= ' Plugin';
1501                        }
1502                        push @{ $addons{$type} },
1503                          {
1504                            label    => $label,
1505                            id       => $id,
1506                            envelope => 'addons/' . $p . '/',
1507                            path     => $full_path,
1508                          };
1509                    }
1510                }
1511            }
1512        }
1513    }
1514    if ($type) {
1515        my $addons = $addons{$type} ||= [];
1516        return $addons;
1517    }
1518    return 1;
1519}
1520
1521*mt_dir = \&server_path;
1522sub server_path { $_[0]->{mt_dir} }
1523sub app_dir     { $_[0]->{app_dir} }
1524sub config_dir  { $_[0]->{config_dir} }
1525
1526sub component {
1527    my $mt = shift;
1528    my ($id) = @_;
1529    return $Components{ lc $id };
1530}
1531
1532sub publisher {
1533    my $mt = shift;
1534    $mt = $mt->instance unless ref $mt;
1535    unless ( $mt->{WeblogPublisher} ) {
1536        require MT::WeblogPublisher;
1537        $mt->{WeblogPublisher} = new MT::WeblogPublisher();
1538    }
1539    $mt->{WeblogPublisher};
1540}
1541
1542sub rebuild {
1543    my $mt = shift;
1544    $mt->publisher->rebuild(@_)
1545      or return $mt->error( $mt->publisher->errstr );
1546}
1547
1548sub rebuild_entry {
1549    my $mt = shift;
1550    $mt->publisher->rebuild_entry(@_)
1551      or return $mt->error( $mt->publisher->errstr );
1552}
1553
1554sub rebuild_indexes {
1555    my $mt = shift;
1556    $mt->publisher->rebuild_indexes(@_)
1557      or return $mt->error( $mt->publisher->errstr );
1558}
1559
1560sub rebuild_archives {
1561    my $mt = shift;
1562    $mt->publisher->rebuild_archives(@_)
1563      or return $mt->error( $mt->publisher->errstr );
1564}
1565
1566sub ping {
1567    my $mt    = shift;
1568    my %param = @_;
1569    my $blog;
1570    require MT::Entry;
1571    require MT::Util;
1572    unless ( $blog = $param{Blog} ) {
1573        my $blog_id = $param{BlogID};
1574        $blog = MT::Blog->load($blog_id)
1575          or return $mt->trans_error( "Load of blog '[_1]' failed: [_2]",
1576            $blog_id, MT::Blog->errstr );
1577    }
1578
1579    my (@res);
1580
1581    my $send_updates = 1;
1582    if ( exists $param{OldStatus} ) {
1583        ## If this is a new entry (!$old_status) OR the status was previously
1584        ## set to draft, and is now set to publish, send the update pings.
1585        my $old_status = $param{OldStatus};
1586        if ( $old_status && $old_status eq MT::Entry::RELEASE() ) {
1587            $send_updates = 0;
1588        }
1589    }
1590
1591    if ( $send_updates && !( MT->config->DisableNotificationPings ) ) {
1592        ## Send update pings.
1593        my @updates = $mt->update_ping_list($blog);
1594        for my $url (@updates) {
1595            require MT::XMLRPC;
1596            if ( MT::XMLRPC->ping_update( 'weblogUpdates.ping', $blog, $url ) )
1597            {
1598                push @res, { good => 1, url => $url, type => "update" };
1599            }
1600            else {
1601                push @res,
1602                  {
1603                    good  => 0,
1604                    url   => $url,
1605                    type  => "update",
1606                    error => MT::XMLRPC->errstr
1607                  };
1608            }
1609        }
1610        if ( $blog->mt_update_key ) {
1611            require MT::XMLRPC;
1612            if ( MT::XMLRPC->mt_ping($blog) ) {
1613                push @res,
1614                  {
1615                    good => 1,
1616                    url  => $mt->{cfg}->MTPingURL,
1617                    type => "update"
1618                  };
1619            }
1620            else {
1621                push @res,
1622                  {
1623                    good  => 0,
1624                    url   => $mt->{cfg}->MTPingURL,
1625                    type  => "update",
1626                    error => MT::XMLRPC->errstr
1627                  };
1628            }
1629        }
1630    }
1631
1632    my $cfg     = $mt->{cfg};
1633    my $send_tb = $cfg->OutboundTrackbackLimit;
1634    return \@res if $send_tb eq 'off';
1635
1636    my @tb_domains;
1637    if ( $send_tb eq 'selected' ) {
1638        @tb_domains = $cfg->OutboundTrackbackDomains;
1639    }
1640    elsif ( $send_tb eq 'local' ) {
1641        my $iter = MT::Blog->load_iter();
1642        while ( my $b = $iter->() ) {
1643            next if $b->id == $blog->id;
1644            push @tb_domains, MT::Util::extract_domains( $b->site_url );
1645        }
1646    }
1647    my $tb_domains;
1648    if (@tb_domains) {
1649        $tb_domains = '';
1650        my %seen;
1651        local $_;
1652        foreach (@tb_domains) {
1653            next unless $_;
1654            $_ = lc($_);
1655            next if $seen{$_};
1656            $tb_domains .= '|' if $tb_domains ne '';
1657            $tb_domains .= quotemeta($_);
1658            $seen{$_} = 1;
1659        }
1660        $tb_domains = '(' . $tb_domains . ')' if $tb_domains;
1661    }
1662
1663    ## Send TrackBack pings.
1664    if ( my $entry = $param{Entry} ) {
1665        my $pings = $entry->to_ping_url_list;
1666
1667        my %pinged = map { $_ => 1 } @{ $entry->pinged_url_list };
1668        my $cats = $entry->categories;
1669        for my $cat (@$cats) {
1670            push @$pings, grep !$pinged{$_}, @{ $cat->ping_url_list };
1671        }
1672
1673        my $ua = MT->new_ua;
1674
1675        ## Build query string to be sent on each ping.
1676        my @qs;
1677        push @qs, 'title=' . MT::Util::encode_url( $entry->title );
1678        push @qs, 'url=' . MT::Util::encode_url( $entry->permalink );
1679        push @qs, 'excerpt=' . MT::Util::encode_url( $entry->get_excerpt );
1680        push @qs, 'blog_name=' . MT::Util::encode_url( $blog->name );
1681        my $qs = join '&', @qs;
1682
1683        ## Character encoding--best guess.
1684        my $enc = $mt->{cfg}->PublishCharset;
1685
1686        for my $url (@$pings) {
1687            $url =~ s/^\s*//;
1688            $url =~ s/\s*$//;
1689            my $url_domain;
1690            ($url_domain) = MT::Util::extract_domains($url);
1691            next if $tb_domains && lc($url_domain) !~ m/$tb_domains$/;
1692
1693            my $req = HTTP::Request->new( POST => $url );
1694            $req->content_type(
1695                "application/x-www-form-urlencoded; charset=$enc");
1696            $req->content($qs);
1697            my $res = $ua->request($req);
1698            if ( substr( $res->code, 0, 1 ) eq '2' ) {
1699                my $c = $res->content;
1700                my ( $error, $msg ) =
1701                  $c =~ m!<error>(\d+).*<message>(.+?)</message>!s;
1702                if ($error) {
1703                    push @res,
1704                      {
1705                        good  => 0,
1706                        url   => $url,
1707                        type  => 'trackback',
1708                        error => $msg
1709                      };
1710                }
1711                else {
1712                    push @res, { good => 1, url => $url, type => 'trackback' };
1713                }
1714            }
1715            else {
1716                push @res,
1717                  {
1718                    good  => 0,
1719                    url   => $url,
1720                    type  => 'trackback',
1721                    error => "HTTP error: " . $res->status_line
1722                  };
1723            }
1724        }
1725    }
1726    \@res;
1727}
1728
1729sub ping_and_save {
1730    my $mt    = shift;
1731    my %param = @_;
1732    if ( my $entry = $param{Entry} ) {
1733        my $results = MT::ping( $mt, @_ ) or return;
1734        my %still_ping;
1735        my $pinged = $entry->pinged_url_list;
1736        for my $res (@$results) {
1737            next if $res->{type} ne 'trackback';
1738            if ( !$res->{good} ) {
1739                $still_ping{ $res->{url} } = 1;
1740            }
1741            push @$pinged,
1742              $res->{url}
1743              . ( $res->{good}
1744                ? ''
1745                : ' ' . MT::I18N::encode_text( $res->{error} ) );
1746        }
1747        $entry->pinged_urls( join "\n", @$pinged );
1748        $entry->to_ping_urls( join "\n", keys %still_ping );
1749        $entry->save or return $mt->error( $entry->errstr );
1750        return $results;
1751    }
1752    1;
1753}
1754
1755sub needs_ping {
1756    my $mt    = shift;
1757    my %param = @_;
1758    my $blog  = $param{Blog};
1759    my $entry = $param{Entry};
1760    require MT::Entry;
1761    return unless $entry->status == MT::Entry::RELEASE();
1762    my $old_status = $param{OldStatus};
1763    my %list;
1764    ## If this is a new entry (!$old_status) OR the status was previously
1765    ## set to draft, and is now set to publish, send the update pings.
1766    if ( ( !$old_status || $old_status ne MT::Entry::RELEASE() )
1767        && !( MT->config->DisableNotificationPings ) )
1768    {
1769        my @updates = $mt->update_ping_list($blog);
1770        @list{@updates} = (1) x @updates;
1771        $list{ $mt->{cfg}->MTPingURL } = 1 if $blog && $blog->mt_update_key;
1772    }
1773    if ($entry) {
1774        @list{ @{ $entry->to_ping_url_list } } = ();
1775        my %pinged = map { $_ => 1 } @{ $entry->pinged_url_list };
1776        my $cats = $entry->categories;
1777        for my $cat (@$cats) {
1778            @list{ grep !$pinged{$_}, @{ $cat->ping_url_list } } = ();
1779        }
1780    }
1781    my @list = keys %list;
1782    return unless @list;
1783    \@list;
1784}
1785
1786sub update_ping_list {
1787    my $mt = shift;
1788    my ($blog) = @_;
1789
1790    my @updates;
1791    if ( my $pings = MT->registry('ping_servers') ) {
1792        my $up = $blog->update_pings;
1793        if ($up) {
1794            foreach ( split ',', $up ) {
1795                next unless exists $pings->{$_};
1796                push @updates, $pings->{$_}->{url};
1797            }
1798        }
1799    }
1800    if ( my $others = $blog->ping_others ) {
1801        push @updates, split /\r?\n/, $others;
1802    }
1803    my %updates;
1804    for my $url (@updates) {
1805        for ($url) {
1806            s/^\s*//;
1807            s/\s*$//;
1808        }
1809        next unless $url =~ /\S/;
1810        $updates{$url}++;
1811    }
1812    keys %updates;
1813}
1814
1815{
1816    my $LH;
1817
1818    sub set_language {
1819        my $pkg = shift;
1820        require MT::L10N;
1821        $LH = MT::L10N->get_handle(@_);
1822
1823        # Clear any l10n_handles in request
1824        $pkg->request( 'l10n_handle', {} );
1825        return $LH;
1826    }
1827
1828    require MT::I18N;
1829
1830    sub translate {
1831        my $this = shift;
1832        my $app = ref($this) ? $this : $this->app;
1833        if ( $app->{component} ) {
1834            if ( my $c = $app->component( $app->{component} ) ) {
1835                local $app->{component} = undef;
1836                return $c->translate(@_);
1837            }
1838        }
1839        my ( $format, @args ) = @_;
1840        foreach (@args) {
1841            $_ = $_->() if ref($_) eq 'CODE';
1842        }
1843        my $enc = MT->instance->config('PublishCharset') || 'utf-8';
1844        return $LH->maketext( $format, @args ) if $enc =~ m/utf-?8/i;
1845        $format = MT::I18N::encode_text( $format, $enc, 'utf-8' );
1846        MT::I18N::encode_text(
1847            $LH->maketext(
1848                $format,
1849                map { MT::I18N::encode_text( $_, $enc, 'utf-8' ) } @args
1850            ),
1851            'utf-8', $enc
1852        );
1853    }
1854
1855    sub translate_templatized {
1856        my $mt = shift;
1857        my $app = ref($mt) ? $mt : $mt->app;
1858        if ( $app->{component} ) {
1859            if ( my $c = $app->component( $app->{component} ) ) {
1860                local $app->{component} = undef;
1861                return $c->translate_templatized(@_);
1862            }
1863        }
1864        my @cstack;
1865        my ($text) = @_;
1866        while (1) {
1867            return '' unless $text;
1868            $text =~ s!(<(/)?(?:_|MT)_TRANS(_SECTION)?(?:(?:\s+((?:\w+)\s*=\s*(["'])(?:(<(?:[^"'>]|"[^"]*"|'[^']*')+)?>|[^\5]+?)*?\5))+?\s*/?)?>)!
1869            my($msg, $close, $section, %args) = ($1, $2, $3);
1870            while ($msg =~ /\b(\w+)\s*=\s*(["'])((?:<(?:[^"'>]|"[^"]*"|'[^']*')+?>|[^\2])*?)?\2/g) {  #"
1871                $args{$1} = $3;
1872            }
1873            if ($section) {
1874                if ($close) {
1875                    $mt = pop @cstack;
1876                } else {
1877                    if ($args{component}) {
1878                        push @cstack, $mt;
1879                        $mt = MT->component($args{component})
1880                            or die "Bad translation component: $args{component}";
1881                    }
1882                    else {
1883                        die "__trans_section without a component argument";
1884                    }
1885                }
1886                '';
1887            }
1888            else {
1889                $args{params} = '' unless defined $args{params};
1890                my @p = map MT::Util::decode_html($_),
1891                        split /\s*%%\s*/, $args{params}, -1;
1892                @p = ('') unless @p;
1893                my $translation = $mt->translate($args{phrase}, @p);
1894                if (exists $args{escape}) {
1895                    if (lc($args{escape}) eq 'html') {
1896                        $translation = MT::Util::encode_html($translation);
1897                    } elsif (lc($args{escape}) eq 'url') {
1898                        $translation = MT::Util::encode_url($translation);
1899                    } else {
1900                        # fallback for js/javascript/singlequotes
1901                        $translation = MT::Util::encode_js($translation);
1902                    }
1903                }
1904                $translation;
1905            }
1906            !igem or last;
1907        }
1908        return $text;
1909    }
1910
1911    sub current_language { $LH->language_tag }
1912    sub language_handle  { $LH }
1913
1914    sub charset {
1915        my $mt = shift;
1916        $mt->{charset} = shift if @_;
1917        return $mt->{charset} if $mt->{charset};
1918        $mt->{charset} = $mt->config->PublishCharset
1919          || $mt->language_handle->encoding;
1920    }
1921}
1922
1923sub supported_languages {
1924    my $mt = shift;
1925    require MT::L10N;
1926    require File::Basename;
1927    ## Determine full path to lib/MT/L10N directory...
1928    my $lib =
1929      File::Spec->catdir( File::Basename::dirname( $INC{'MT/L10N.pm'} ),
1930        'L10N' );
1931    ## ... From that, determine full path to extlib/MT/L10N.
1932    ## To do that, we look for the last instance of the string 'lib'
1933    ## in $lib and replace it with 'extlib'. reverse is a nice tricky
1934    ## way of doing that.
1935    ( my $extlib = reverse $lib ) =~ s!bil!biltxe!;
1936    $extlib = reverse $extlib;
1937    my @dirs = ( $lib, $extlib );
1938    my %langs;
1939    for my $dir (@dirs) {
1940        opendir DH, $dir or next;
1941        for my $f ( readdir DH ) {
1942            my ($tag) = $f =~ /^(\w+)\.pm$/;
1943            next unless $tag;
1944            my $lh = MT::L10N->get_handle($tag);
1945            $langs{ $lh->language_tag } = $lh->language_name;
1946        }
1947        closedir DH;
1948    }
1949    \%langs;
1950}
1951
1952# For your convenience
1953sub trans_error {
1954    my $app = shift;
1955    $app->error( $app->translate(@_) );
1956}
1957
1958sub all_text_filters {
1959    unless (%Text_filters) {
1960        if ( my $filters = MT->registry('text_filters') ) {
1961            %Text_filters = %$filters if ref($filters) eq 'HASH';
1962        }
1963    }
1964    if (my $enabled_filters = MT->config('AllowedTextFilters')) {
1965        my %enabled = map { $_ => 1 } split /\s*,\s*/, $enabled_filters;
1966        %Text_filters = map { $_ => $Text_filters{$_} }
1967                        grep { exists $enabled{$_} }
1968                        keys %Text_filters;
1969    }
1970    return \%Text_filters;
1971}
1972
1973sub apply_text_filters {
1974    my $mt = shift;
1975    my ( $str, $filters, @extra ) = @_;
1976    my $all_filters = $mt->all_text_filters;
1977    for my $filter (@$filters) {
1978        my $f = $all_filters->{$filter} or next;
1979        my $code = $f->{code} || $f->{handler};
1980        unless ( ref($code) eq 'CODE' ) {
1981            $code = $mt->handler_to_coderef($code);
1982            $f->{code} = $code;
1983        }
1984        if ( !$code ) {
1985            warn "Bad text filter: $filter";
1986            next;
1987        }
1988        $str = $code->( $str, @extra );
1989    }
1990    return $str;
1991}
1992
1993sub static_path {
1994    my $app = shift;
1995    my $spath = $app->config->StaticWebPath;
1996    if (!$spath) {
1997        $spath = $app->config->CGIPath;
1998        $spath .= '/' unless $spath =~ m!/$!;
1999        $spath .= 'mt-static/';
2000    } else {
2001        $spath .= '/' unless $spath =~ m!/$!;
2002    }
2003    $spath;
2004}
2005
2006sub static_file_path {
2007    my $app = shift;
2008    return $app->{__static_file_path}
2009        if exists $app->{__static_file_path};
2010
2011    my $path = $app->config('StaticFilePath');
2012    return $app->{__static_file_path} = $path if defined $path;
2013
2014    # Attempt to derive StaticFilePath based on environment
2015    my $web_path = $app->config->StaticWebPath || 'mt-static';
2016    $web_path =~ s!^https?://[^/]+/!!;
2017    if ($app->can('document_root')) {
2018        my $doc_static_path = File::Spec->catdir($app->document_root(), $web_path);
2019        return $app->{__static_file_path} = $doc_static_path
2020            if -d $doc_static_path;
2021    }
2022    my $mtdir_static_path = File::Spec->catdir($app->mt_dir, 'mt-static');
2023    return $app->{__static_file_path} = $mtdir_static_path
2024        if -d $mtdir_static_path;
2025    return;
2026}
2027
2028sub template_paths {
2029    my $mt = shift;
2030    my @paths;
2031    my $path = $mt->config->TemplatePath;
2032    if ($mt->{plugin_template_path}) {
2033        if (File::Spec->file_name_is_absolute($mt->{plugin_template_path})) {
2034            push @paths, $mt->{plugin_template_path}
2035                if -d $mt->{plugin_template_path};
2036        } else {
2037            my $dir = File::Spec->catdir($mt->app_dir,
2038                                         $mt->{plugin_template_path}); 
2039            if (-d $dir) {
2040                push @paths, $dir;
2041            } else {
2042                $dir = File::Spec->catdir($mt->mt_dir,
2043                                          $mt->{plugin_template_path});
2044                push @paths, $dir if -d $dir;
2045            }
2046        }
2047    }
2048    if (my $alt_path = $mt->config->AltTemplatePath) {
2049        if (-d $alt_path) {    # AltTemplatePath is absolute
2050            push @paths, File::Spec->catdir($alt_path,
2051                                            $mt->{template_dir})
2052                if $mt->{template_dir};
2053            push @paths, $alt_path;
2054        }
2055    }
2056 
2057    for my $addon ( @{ $mt->find_addons('pack') } ) {
2058        push @paths, File::Spec->catdir($addon->{path}, 'tmpl', $mt->{template_dir})
2059            if $mt->{template_dir};
2060        push @paths, File::Spec->catdir($addon->{path}, 'tmpl');
2061    }
2062
2063    push @paths, File::Spec->catdir($path, $mt->{template_dir})
2064        if $mt->{template_dir};
2065    push @paths, $path;
2066 
2067    return @paths;
2068}
2069
2070sub find_file {
2071    my $mt = shift;
2072    my ($paths, $file) = @_;
2073    my $filename;
2074    foreach my $p (@$paths) {
2075        my $filepath = File::Spec->canonpath(File::Spec->catfile($p, $file));
2076        $filename = File::Spec->canonpath($filepath);
2077        return $filename if -f $filename;
2078    }
2079    undef;
2080}
2081
2082sub load_global_tmpl {
2083    my $app = shift;
2084    my ( $arg, $blog_id ) = @_;
2085    $blog_id
2086        = $blog_id ? [ $blog_id, 0 ]
2087        : MT->app->blog ? [ MT->app->blog->id, 0 ]
2088        :                 0;
2089
2090    my $terms = {};
2091    if ( 'HASH' eq ref($arg) ) {
2092        $terms = { %$arg, blog_id => $blog_id };
2093    }
2094    else {
2095        $terms = {
2096            type => $arg,
2097            blog_id => $blog_id,
2098        }
2099    }
2100    my $args;
2101    if (ref $blog_id eq 'ARRAY') {
2102       $args->{sort} = 'blog_id';
2103       $args->{direction} = 'descend';
2104       $args->{limit} = 1;
2105    }
2106    require MT::Template;
2107    my $tmpl = MT::Template->load( $terms, $args);
2108    $app->set_default_tmpl_params($tmpl) if $tmpl;
2109    $tmpl;
2110}
2111
2112sub load_tmpl {
2113    my $mt = shift;
2114    if ( exists($mt->{component}) && ( $mt->{component} ne 'Core' ) ) {
2115        if (my $c = $mt->component($mt->{component})) {
2116            return $c->load_tmpl(@_);
2117        }
2118    }
2119
2120    my($file, @p) = @_;
2121    my $param;
2122    if (@p && (ref($p[$#p]) eq 'HASH')) {
2123        $param = pop @p;
2124    }
2125    my $cfg = $mt->config;
2126    require MT::Template;
2127    my $tmpl;
2128    my @paths = $mt->template_paths;
2129
2130    my $type = {'SCALAR' => 'scalarref', 'ARRAY' => 'arrayref'}->{ref $file}
2131        || 'filename';
2132    $tmpl = MT::Template->new(
2133        type => $type, source => $file,
2134        path => \@paths,
2135        filter => sub {
2136            my ($str, $fname) = @_;
2137            if ($fname) {
2138                $fname = File::Basename::basename($fname);
2139                $fname =~ s/\.tmpl$//;
2140                $mt->run_callbacks("template_source.$fname", $mt, @_);
2141            } else {
2142                $mt->run_callbacks("template_source", $mt, @_);
2143            }
2144            return $str;
2145        },
2146        @p);
2147    return $mt->error(
2148        $mt->translate("Loading template '[_1]' failed.", $file)) unless $tmpl;
2149    $mt->set_default_tmpl_params($tmpl);
2150    $tmpl->param($param) if $param;
2151    $tmpl;
2152}
2153
2154sub set_default_tmpl_params {
2155    my $mt = shift;
2156    my ($tmpl) = @_;
2157    my $param = {};
2158    $param->{mt_debug} = $MT::DebugMode;
2159    $param->{mt_beta} = 1 if MT->version_id =~ m/^\d+\.\d+(?:a|b|rc)/;
2160    $param->{static_uri} = $mt->static_path;
2161    $param->{mt_version} = MT->version_number;
2162    $param->{mt_version_id} = MT->version_id;
2163    $param->{mt_product_code} = MT->product_code;
2164    $param->{mt_product_name} = $mt->translate(MT->product_name);
2165    $param->{language_tag} = substr($mt->current_language, 0, 2);
2166    $param->{language_encoding} = $mt->charset;
2167    $param->{optimize_ui} = $mt->build_id && !$MT::DebugMode;
2168    if ($mt->isa('MT::App')) {
2169        if (my $author = $mt->user) {
2170            $param->{author_id} = $author->id;
2171            $param->{author_name} = $author->name;
2172        }
2173        ## We do this in load_tmpl because show_error and login don't call
2174        ## build_page; so we need to set these variables here.
2175        require MT::Auth;
2176        $param->{can_logout} = MT::Auth->can_logout;
2177        $param->{script_url} = $mt->uri;
2178        $param->{mt_url} = $mt->mt_uri;
2179        $param->{script_path} = $mt->path;
2180        $param->{script_full_url} = $mt->base . $mt->uri;
2181        $param->{agent_mozilla} = ( $ENV{HTTP_USER_AGENT} || '' ) =~ /gecko/i;
2182        $param->{agent_ie} = ( $ENV{HTTP_USER_AGENT} || '' ) =~ /\bMSIE\b/;
2183    }
2184    if (!$tmpl->param('template_filename')) {
2185        if (my $fname = $tmpl->{__file}) {
2186            $fname =~ s!\\!/!g;
2187            $fname =~ s/\.tmpl$//;
2188            $param->{template_filename} = $fname;
2189        }
2190    }
2191    $tmpl->param($param);
2192}
2193
2194sub process_mt_template {
2195    my $mt = shift;
2196    my ($body) = @_;
2197    $body =~ s@<(?:_|MT)_ACTION\s+mode="([^"]+)"(?:\s+([^>]*))?>@
2198        my $mode = $1; my %args;
2199        %args = $2 =~ m/\s*(\w+)="([^"]*?)"\s*/g if defined $2; # "
2200        MT::Util::encode_html($mt->uri(mode => $mode, args => \%args));
2201    @geis;
2202    # Strip out placeholder wrappers to facilitate tmpl_* callbacks
2203    $body =~ s/<\/?MT_(\w+):(\w+)>//g;
2204    $body;
2205}
2206
2207sub build_page {
2208    my $mt = shift;
2209    my($file, $param) = @_;
2210    my $tmpl;
2211    my $mode = $mt->mode;
2212    $param->{"mode_$mode"} ||= 1;
2213    $param->{breadcrumbs} = $mt->{breadcrumbs};
2214    if ($param->{breadcrumbs}[-1]) {
2215        $param->{breadcrumbs}[-1]{is_last} = 1;
2216        $param->{page_titles} = [ reverse @{ $mt->{breadcrumbs} } ];
2217    }
2218    pop @{ $param->{page_titles} };
2219    if (my $lang_id = $mt->current_language) {
2220        $param->{local_lang_id} ||= lc $lang_id;
2221    }
2222    $param->{magic_token} = $mt->current_magic if $mt->user;
2223
2224    # List of installed packs in the application footer
2225    my @packs_installed;
2226    my $packs = $mt->find_addons('pack');
2227    if ($packs) {
2228        foreach my $pack (@$packs) {
2229            my $c = $mt->component(lc $pack->{id});
2230            if ($c) {
2231                my $label = $c->label || $pack->{label};
2232                $label = $label->() if ref($label) eq 'CODE';
2233                # if the component did not declare a label,
2234                # it isn't wanting to be visible on the app footer.
2235                next if $label eq $c->{plugin_sig};
2236                push @packs_installed, {
2237                    label => $label,
2238                    version => $c->version,
2239                    id => $c->id,
2240                };
2241            }
2242        }
2243    }
2244    @packs_installed = sort { $a->{label} cmp $b->{label} } @packs_installed;
2245    $param->{packs_installed} = \@packs_installed;
2246   
2247    $param->{portal_url} = &portal_url;
2248
2249    for my $config_field (keys %{ MT::ConfigMgr->instance->{__var} || {} }) {
2250        $param->{ $config_field . '_readonly' } = 1;
2251    }
2252
2253    my $tmpl_file = '';
2254    if (UNIVERSAL::isa($file, 'MT::Template')) {
2255        $tmpl = $file;
2256        $tmpl_file = (exists $file->{__file}) ? $file->{__file} : '';
2257    } else {
2258        $tmpl = $mt->load_tmpl($file) or return;
2259        $tmpl_file = $file unless ref($file);
2260    }
2261
2262    if (($mode && ($mode !~ m/delete/)) && ($mt->{login_again} ||
2263        ($mt->{requires_login} && !$mt->user))) {
2264        ## If it's a login screen, direct the user to where they were going
2265        ## (query params including mode and all) unless they were logging in,
2266        ## logging out, or deleting something.
2267        my $q = $mt->{query};
2268        if ($mode) {
2269            my @query = map { { name => $_, value => scalar encode_text( $q->param($_) ) }; }
2270                grep { ($_ ne 'username') && ($_ ne 'password') && ($_ ne 'submit') && ($mode eq 'logout' ? ($_ ne '__mode') : 1) } $q->param;
2271            $param->{query_params} = \@query;
2272        }
2273        $param->{login_again} = $mt->{login_again};
2274    }
2275
2276    my $blog = $mt->blog;
2277    $tmpl->context()->stash('blog', $blog) if $blog;
2278
2279    $tmpl->param($param) if $param;
2280
2281    if ($tmpl_file) {
2282        $tmpl_file = File::Basename::basename($tmpl_file);
2283        $tmpl_file =~ s/\.tmpl$//;
2284        $tmpl_file = '.' . $tmpl_file;
2285    }
2286    $mt->run_callbacks('template_param' . $tmpl_file, $mt, $tmpl->param, $tmpl);
2287
2288    my $output = $mt->build_page_in_mem($tmpl);
2289    return unless defined $output;
2290
2291    $mt->run_callbacks('template_output' . $tmpl_file, $mt, \$output, $tmpl->param, $tmpl);
2292    return $output;
2293}
2294
2295sub build_page_in_mem {
2296    my $mt = shift;
2297    my($tmpl, $param) = @_;
2298    $tmpl->param($param) if $param;
2299    my $out = $tmpl->output;
2300    return $mt->error($tmpl->errstr) unless defined $out;
2301    return $mt->translate_templatized($mt->process_mt_template($out));
2302}
2303
2304sub new_ua {
2305    my $class = shift;
2306    my ($opt) = @_;
2307    $opt ||= {};
2308    my $lwp_class = 'LWP::UserAgent';
2309    if ($opt->{paranoid}) {
2310        eval { require LWPx::ParanoidAgent; };
2311        $lwp_class = 'LWPx::ParanoidAgent' unless $@;
2312    }
2313    eval "require $lwp_class;";
2314    return undef if $@;
2315    my $cfg = $class->config;
2316    my $max_size = exists $opt->{max_size} ? $opt->{max_size} : 100_000;
2317    my $timeout = exists $opt->{timeout} ? $opt->{timeout} : $cfg->HTTPTimeout || $cfg->PingTimeout;
2318    my $proxy = exists $opt->{proxy} ? $opt->{proxy} : $cfg->HTTPProxy || $cfg->PingProxy;
2319    my $sec_proxy = exists $opt->{sec_proxy} ? $opt->{sec_proxy} : $cfg->HTTPSProxy;
2320    my $no_proxy = exists $opt->{no_proxy} ? $opt->{no_proxy} : $cfg->HTTPNoProxy || $cfg->PingNoProxy;
2321    my $agent = $opt->{agent} || 'MovableType/' . $MT::VERSION;
2322    my $interface = exists $opt->{interface} ? $opt->{interface} : $cfg->HTTPInterface || $cfg->PingInterface;
2323
2324    if ( my $localaddr = $interface ) {
2325        @LWP::Protocol::http::EXTRA_SOCK_OPTS = (
2326            LocalAddr => $localaddr,
2327            Reuse     => 1
2328        );
2329    }
2330
2331    my $ua = $lwp_class->new;
2332    $ua->max_size($max_size) if (defined $max_size) && $ua->can('max_size');
2333    $ua->agent( $agent );
2334    $ua->timeout( $timeout ) if defined $timeout;
2335    if ( defined $proxy ) {
2336        $ua->proxy( http => $proxy );
2337        my @domains = split( /,\s*/, $no_proxy ) if $no_proxy;
2338        $ua->no_proxy(@domains) if @domains;
2339    }
2340    if ( defined $sec_proxy ) {
2341        $ua->proxy ( https => $sec_proxy );
2342    }
2343    return $ua;
2344}
2345
2346sub build_email {
2347    my $class = shift;
2348    my ( $file, $param ) = @_;
2349    my $mt = $class->instance;
2350
2351    # basically, try to load from database
2352    my $blog = $param->{blog} || undef;
2353    my $id = $file;
2354    $id =~ s/(\.tmpl|\.mtml)$//;
2355
2356    require MT::Template;
2357    my @tmpl = MT::Template->load(
2358        {
2359            ( $blog ? ( blog_id => [ $blog->id, 0 ] ) : ( blog_id => 0 ) ),
2360            identifier => $id,
2361            type       => 'email',
2362        }
2363    );
2364    my $tmpl =
2365      @tmpl
2366      ? (
2367        scalar @tmpl > 1
2368        ? ( $tmpl[0]->blog_id ? $tmpl[0] : $tmpl[1] )
2369        : $tmpl[0]
2370      )
2371      : undef;
2372
2373    # try to load from file
2374    unless ($tmpl) {
2375        local $mt->{template_dir} = 'email';
2376        $tmpl = $mt->load_tmpl($file);
2377    }
2378    return unless $tmpl;
2379
2380    my $ctx = $tmpl->context;
2381    $ctx->stash( 'blog_id', $blog->id ) if $blog;
2382    $ctx->stash( 'blog',   delete $param->{'blog'} )   if $param->{'blog'};
2383    $ctx->stash( 'entry',  delete $param->{'entry'} )  if $param->{'entry'};
2384    $ctx->stash( 'author', delete $param->{'author'} ) if $param->{'author'};
2385    $ctx->stash( 'commenter', delete $param->{'commenter'} )
2386      if $param->{'commenter'};
2387    $ctx->stash( 'comment', delete $param->{'comment'} ) if $param->{'comment'};
2388    $ctx->stash( 'category', delete $param->{'category'} )
2389      if $param->{'category'};
2390    $ctx->stash( 'ping', delete $param->{'ping'} ) if $param->{'ping'};
2391
2392    foreach my $p (%$param) {
2393        if ( ref($p) ) {
2394            $tmpl->param( $p, $param->{$p} );
2395        }
2396    }
2397    return $mt->build_page_in_mem( $tmpl, $param );
2398}
2399
2400sub get_next_sched_post_for_user {
2401    my ( $author_id, @further_blog_ids ) = @_;
2402    require MT::Permission;
2403    my @perms = MT::Permission->load( { author_id => $author_id }, {} );
2404    my @blogs = @further_blog_ids;
2405    for my $perm (@perms) {
2406        next
2407          unless ( $perm->can_edit_config
2408            || $perm->can_publish_post
2409            || $perm->can_edit_all_posts );
2410        push @blogs, $perm->blog_id;
2411    }
2412    my $next_sched_utc = undef;
2413    require MT::Entry;
2414    for my $blog_id (@blogs) {
2415        my $blog           = MT::Blog->load($blog_id)
2416            or next;
2417        my $earliest_entry = MT::Entry->load(
2418            {
2419                status  => MT::Entry::FUTURE(),
2420                blog_id => $blog_id
2421            },
2422            { 'sort' => 'created_on' }
2423        );
2424        if ($earliest_entry) {
2425            my $entry_utc =
2426              MT::Util::ts2iso( $blog, $earliest_entry->created_on );
2427            if ( $entry_utc < $next_sched_utc || !defined($next_sched_utc) ) {
2428                $next_sched_utc = $entry_utc;
2429            }
2430        }
2431    }
2432    return $next_sched_utc;
2433}
2434
2435our %Commenter_Auth;
2436
2437sub init_commenter_authenticators {
2438    my $self = shift;
2439    my $auths = $self->registry("commenter_authenticators") || {};
2440    %Commenter_Auth = %$auths;
2441    my $app = $self->app;
2442    my $blog = $app->blog if $app->isa('MT::App');
2443    foreach my $auth ( keys %$auths ) {
2444        if ( my $c = $auths->{$auth}->{condition} ) {
2445            $c = $self->handler_to_coderef($c);
2446            if ( $c ) {
2447                delete $Commenter_Auth{$auth} unless $c->($blog);
2448            }
2449        }
2450    }
2451    $Commenter_Auth{$_}{key} ||= $_ for keys %Commenter_Auth;
2452} 
2453
2454sub commenter_authenticator {
2455    my $self = shift;
2456    my ($key) = @_;
2457    %Commenter_Auth or $self->init_commenter_authenticators();
2458    return $Commenter_Auth{$key};
2459}
2460
2461sub commenter_authenticators {
2462    my $self = shift;
2463    %Commenter_Auth or $self->init_commenter_authenticators();
2464    return values %Commenter_Auth;
2465}
2466
2467sub _commenter_auth_params {
2468    my ( $key, $blog_id, $entry_id, $static ) = @_;
2469    my $params = {
2470        blog_id => $blog_id,
2471        static  => $static,
2472    };
2473    $params->{entry_id} = $entry_id if defined $entry_id;
2474    return $params;
2475}
2476
2477sub _openid_commenter_condition {
2478    eval "require Digest::SHA1;";
2479    return $@ ? 0 : 1;
2480}
2481
2482sub core_commenter_authenticators {
2483    return {
2484        'OpenID' => {
2485            class      => 'MT::Auth::OpenID',
2486            label      => 'OpenID',
2487            login_form => <<OpenID,
2488<form method="post" action="<mt:var name="script_url">">
2489<input type="hidden" name="__mode" value="login_external" />
2490<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2491<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2492<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2493<fieldset>
2494<mtapp:setting
2495    id="openid_display"
2496    label="<__trans phrase="OpenID URL">"
2497    hint="<__trans phrase="Sign in using your OpenID identity.">">
2498<input type="hidden" name="key" value="OpenID" />
2499<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%;" />
2500    <p class="hint"><__trans phrase="OpenID is an open and decentralized single sign-on identity system."></p>
2501</mtapp:setting>
2502<img src="<mt:var name="static_uri">images/comment/openid_enabled.png" class="right" />
2503<div class="actions-bar actions-bar-login">
2504    <div class="actions-bar-inner pkg actions">
2505        <button
2506            type="submit"
2507            class="primary-button"
2508            ><__trans phrase="Sign in"></button>
2509    </div>
2510</div>
2511<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>
2512</fieldset>
2513</form>
2514OpenID
2515            login_form_params => \&_commenter_auth_params,
2516            condition         => \&_openid_commenter_condition,
2517            logo              => 'images/comment/signin_openid.png',
2518            logo_small        => 'images/comment/openid_logo.png',
2519            order => 10,
2520        },
2521        'LiveJournal' => {
2522            class      => 'MT::Auth::LiveJournal',
2523            label      => 'LiveJournal',
2524            login_form => <<LiveJournal,
2525<form method="post" action="<mt:var name="script_url">">
2526<input type="hidden" name="__mode" value="login_external" />
2527<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2528<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2529<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2530<input type="hidden" name="key" value="LiveJournal" />
2531<fieldset>
2532<mtapp:setting
2533    id="livejournal_display"
2534    label="<__trans phrase="Your LiveJournal Username">">
2535<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%;" />
2536</mtapp:setting>
2537<div class="actions-bar actions-bar-login">
2538    <div class="actions-bar-inner pkg actions">
2539        <button
2540            type="submit"
2541            class="primary-button"
2542            ><__trans phrase="Sign in"></button>
2543    </div>
2544</div>
2545<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>
2546</fieldset>
2547</form>
2548LiveJournal
2549            login_form_params => \&_commenter_auth_params,
2550            condition         => \&_openid_commenter_condition,
2551            logo              => 'images/comment/signin_livejournal.png',