root/trunk/lib/MT.pm @ 3082

Revision 3082, 106.9 kB (checked in by bchoate, 14 months ago)

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