root/trunk/lib/MT.pm @ 3892

Revision 3892, 132.8 kB (checked in by fumiakiy, 5 months ago)

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