root/branches/release-33/lib/MT.pm.pre @ 1769

Revision 1769, 105.0 kB (checked in by fumiakiy, 20 months ago)

Stopped saving something in the database while database driver is being initialized. Let us see if this fixes the occasional "Time to Upgrade!" bug. BugId:58199
  • Property svn:keywords set to Author Date Id Revision
Line 
1# Movable Type (r) Open Source (C) 2001-2008 Six Apart, Ltd.
2# This program is distributed under the terms of the
3# GNU General Public License, version 2.
4#
5# $Id$
6
7package MT;
8
9use strict;
10use base qw( MT::ErrorHandler );
11use File::Spec;
12use File::Basename;
13use MT::Util qw( weaken );
14
15our ( $VERSION,      $SCHEMA_VERSION );
16our ( $PRODUCT_NAME, $PRODUCT_CODE, $PRODUCT_VERSION, $VERSION_ID );
17our ( $MT_DIR,       $APP_DIR, $CFG_DIR, $CFG_FILE, $SCRIPT_SUFFIX );
18our (
19    $plugin_sig, $plugin_envelope, $plugin_registry,
20    %Plugins,    @Components,      %Components,
21    $DebugMode,  $mt_inst,         %mt_inst
22);
23my %Text_filters;
24
25# For state determination in MT::Object
26our $plugins_installed;
27
28BEGIN {
29    $plugins_installed = 0;
30
31    ( $VERSION, $SCHEMA_VERSION ) = ( '__API_VERSION__', '__SCHEMA_VERSION__' );
32    ( $PRODUCT_NAME, $PRODUCT_CODE, $PRODUCT_VERSION, $VERSION_ID ) = (
33        '__PRODUCT_NAME__',    '__PRODUCT_CODE__',
34        '__PRODUCT_VERSION__', '__PRODUCT_VERSION_ID__'
35    );
36
37    $DebugMode = 0;
38
39    # Alias lowercase to uppercase package; note: this is an equivalence
40    # as opposed to having @mt::ISA set to 'MT'. so @mt::Plugins would
41    # resolve as well as @MT::Plugins.
42    *{mt::} = *{MT::};
43
44    # Alias these; Components is the preferred array for MT 4
45    *Plugins = \@Components;
46}
47
48# On-demand loading of compatibility module, if a plugin asks for it, using
49#     use MT 3;
50# or even specific to minor version (but this just loads MT::Compat::v3)
51#     use MT 3.3;
52sub VERSION {
53    my $v = $_[1];
54    if ( defined $v && ( $v =~ m/^(\d+)/ ) ) {
55        my $compat = "MT::Compat::v" . $1;
56        if ( ( $1 > 2 ) && ( $1 < int($VERSION) ) ) {
57            no strict 'refs';
58            unless ( defined *{ $compat . '::' } ) {
59                eval "require $compat;";
60            }
61        }
62    }
63    return UNIVERSAL::VERSION(@_);
64}
65
66sub version_number  { $VERSION }
67sub version_id      { $VERSION_ID }
68sub product_code    { $PRODUCT_CODE }
69sub product_name    { $PRODUCT_NAME }
70sub product_version { $PRODUCT_VERSION }
71sub schema_version  { $SCHEMA_VERSION }
72
73# Default id method turns MT::App::CMS => cms; Foo::Bar => foo/bar
74sub id {
75    my $pkg = shift;
76    my $id = ref($pkg) || $pkg;
77    # ignore the MT::App prefix as part of the identifier
78    $id =~ s/^MT::App:://;
79    $id =~ s!::!/!g;
80    return lc $id;
81}
82
83sub version_slug {
84    return MT->translate_templatized(<<"SLUG");
85<MT_TRANS phrase="Powered by [_1]" params="$PRODUCT_NAME">
86<MT_TRANS phrase="Version [_1]" params="$VERSION_ID">
87<MT_TRANS phrase="http://www.sixapart.com/movabletype/">
88SLUG
89}
90
91sub import {
92    my $pkg = shift;
93    return unless @_;
94
95    my (%param) = @_;
96    my $app_pkg;
97    if ( $app_pkg = $param{app} || $param{App} || $ENV{MT_APP} ) {
98        if ( $app_pkg !~ m/::/ ) {
99            my $apps = $pkg->registry('applications');
100            $app_pkg = $apps->fetch($app_pkg);
101            if ( ref $app_pkg ) {
102
103                # pick first one??
104                $app_pkg = $app_pkg->[0];
105
106                # pick last one??
107                # $app_pkg = pop @$app_pkg;
108            }
109        }
110    }
111    elsif ( $param{run} || $param{Run} ) {
112
113        # my $script = File::Spec->rel2abs($0);
114        my ( $filename, $path, $suffix ) = fileparse( $0, qr{\..+$} );
115        $SCRIPT_SUFFIX = $suffix;
116        my $script = lc $filename;
117        $script =~ s/^mt-//;
118        my $apps = $pkg->registry('applications');
119        $app_pkg = $apps->fetch( lc $script );
120        unless ($app_pkg) {
121            die "cannot determine application for script $0, stopped at";
122        }
123    }
124    $pkg->run_app( $app_pkg, \%param )
125      if $app_pkg;
126}
127
128sub run_app {
129    my $pkg = shift;
130    my ( $class, $param ) = @_;
131
132    # When running under FastCGI, the initial invocation of the
133    # script has a bare environment. We can use this to test
134    # for FastCGI.
135    my $not_fast_cgi = 0;
136    $not_fast_cgi ||= exists $ENV{$_}
137      for qw(HTTP_HOST GATEWAY_INTERFACE SCRIPT_FILENAME SCRIPT_URL);
138    my $fast_cgi = ( !$not_fast_cgi ) || $param->{fastcgi};
139    $fast_cgi =
140      defined( $param->{fastcgi} || $param->{FastCGI} )
141      ? ( $param->{fastcgi} || $param->{FastCGI} )
142      : $fast_cgi;
143    if ($fast_cgi) {
144        eval { require CGI::Fast; };
145        $fast_cgi = 0 if $@;
146    }
147
148    # ready to run now... run inside an eval block so we can gracefully
149    # die if something bad happens
150    my $app;
151    eval {
152        eval "require $class; 1;" or die $@;
153        if ($fast_cgi) {
154            while ( my $cgi = new CGI::Fast ) {
155                $app = $class->new( %$param, CGIObject => $cgi )
156                  or die $class->errstr;
157                local $SIG{__WARN__} = sub { $app->trace( $_[0] ) };
158                $pkg->set_instance($app);
159                $app->init_request( CGIObject => $cgi );
160                $app->run;
161            }
162        }
163        else {
164            $app = $class->new(%$param) or die $class->errstr;
165            local $SIG{__WARN__} = sub { $app->trace( $_[0] ) };
166            $app->run;
167        }
168    };
169    if ( my $err = $@ ) {
170        my $charset = 'utf-8';
171        eval {
172            $app ||= MT->instance;
173            my $cfg = $app->config;
174            my $c   = $app->find_config;
175            $cfg->read_config($c);
176            $charset = $cfg->PublishCharset;
177        };
178        if ( $app && UNIVERSAL::isa( $app, 'MT::App' ) ) {
179            eval {
180                my %param = ( error => $err );
181                if ( $err =~ m/Bad ObjectDriver/ ) {
182                    $param{error_database_connection} = 1;
183                }
184                elsif ( $err =~ m/Bad CGIPath/ ) {
185                    $param{error_cgi_path} = 1;
186                }
187                elsif ( $err =~ m/Missing configuration file/ ) {
188                    $param{error_config_file} = 1;
189                }
190                my $page = $app->build_page( 'error.tmpl', \%param )
191                  or die $app->errstr;
192                print "Content-Type: text/html; charset=$charset\n\n";
193                print $page;
194            };
195            if ( my $err = $@ ) {
196                print "Content-Type: text/plain; charset=$charset\n\n";
197                print $app
198                  ? $app->translate( "Got an error: [_1]", $err )
199                  : "Got an error: $err";
200            }
201        }
202        else {
203            if ( $err =~ m/Missing configuration file/ ) {
204                my $host = $ENV{SERVER_NAME} || $ENV{HTTP_HOST};
205                $host =~ s/:\d+//;
206                my $port = $ENV{SERVER_PORT};
207                my $uri = $ENV{REQUEST_URI} || $ENV{PATH_INFO};
208                $uri =~ s/mt(\Q$SCRIPT_SUFFIX\E)?.*$//;
209                my $cgipath = '';
210                $cgipath = $port == 443 ? 'https' : 'http';
211                $cgipath .= '://' . $host;
212                $cgipath .= ( $port == 443 || $port == 80 ) ? '' : ':' . $port;
213                $cgipath .= $uri;
214
215                print "Status: 302 Moved\n";
216                print "Location: " . $cgipath . "mt-wizard.cgi\n\n";
217            }
218            else {
219                print "Content-Type: text/plain; charset=$charset\n\n";
220                print $app
221                  ? $app->translate( "Got an error: [_1]", $err )
222                  : "Got an error: $err\n";
223            }
224        }
225    }
226}
227
228sub app {
229    my $class = shift;
230    $mt_inst ||= $mt_inst{$class} ||= $class->construct(@_);
231}
232*instance = *app;
233
234sub set_instance {
235    my $class = shift;
236    $mt_inst = shift;
237}
238
239sub new {
240    my $mt = &instance_of;
241    $mt_inst ||= $mt;
242    $mt;
243}
244
245sub instance_of {
246    my $class = shift;
247    $mt_inst{$class} ||= $class->construct(@_);
248}
249
250sub construct {
251    my $class = shift;
252    my $mt = bless {}, $class;
253    local $mt_inst = $mt;
254    $mt->init(@_)
255      or die $mt->errstr;
256    $mt;
257}
258
259{
260    my %object_types;
261
262    sub model {
263        my $pkg = shift;
264        my ($k) = @_;
265        $object_types{$k} = $_[1] if scalar @_ > 1;
266        return $object_types{$k} if exists $object_types{$k};
267
268        my $model = $pkg->registry( 'object_types', $k );
269        if ( ref($model) eq 'ARRAY' ) {
270
271            # First element of an array *should* be a scalar; in case it isn't,
272            # return undef.
273            $model = $model->[0];
274            return undef if ref $model;
275        }
276        elsif ( ref($model) eq 'HASH' ) {
277
278            # If all we have is a hash, this doesn't tell us the package for
279            # this object type, so it's undefined.
280            return undef;
281        }
282        return undef unless $model;
283
284        # Element in object type hash is scalar, so return it
285        no strict 'refs';
286        unless ( defined *{ $model . '::__properties' } ) {
287            use strict 'refs';
288            eval "require $model;";
289            if ( $@ && ( $k =~ m/^(.+)\./ ) ) {
290
291                # x.foo can't be found, so try loading x
292                if ( my $ppkg = $pkg->model($1) ) {
293
294                    # well now see if $model is defined
295                    no strict 'refs';
296                    unless ( defined *{ $model . '::__properties' } ) {
297
298                        # if not, use parent package instead
299                        $model = $ppkg;
300                    }
301                }
302            }
303        }
304        return $object_types{$k} = $model;
305    }
306
307    sub models {
308        my $pkg = shift;
309        my ($k) = @_;
310
311        my @matches;
312        my $model = $pkg->registry('object_types');
313        foreach my $m ( keys %$model ) {
314            if ( $m =~ m/^\Q$k\E\.?/ ) {
315                push @matches, $m;
316            }
317        }
318        return @matches;
319    }
320}
321
322sub registry {
323    my $pkg = shift;
324
325    # if (!ref $pkg) {
326    #     return $pkg->instance->registry(@_);
327    # }
328    require MT::Component;
329    my $regs = MT::Component->registry(@_);
330    my $r;
331    if ($regs) {
332        foreach my $cr (@$regs) {
333
334            # in the event that our registry request returns something
335            # other than an array of hashes, return it as is instead of
336            # merging it together.
337            return $regs unless ref($cr) eq 'HASH';
338
339            # next unless ref($cr) eq 'HASH';
340            delete $cr->{plugin} if exists $cr->{plugin};
341            __merge_hash( $r ||= {}, $cr );
342        }
343    }
344    return $r;
345}
346
347# merges contents of two hashes, giving preference to the right side
348# if $replace is true; otherwise it will always append to the left side.
349sub __merge_hash {
350    my ( $h1, $h2, $replace ) = @_;
351    for my $k ( keys(%$h2) ) {
352        if ( exists( $h1->{$k} ) && ( !$replace ) ) {
353            if ( ref $h1->{$k} eq 'HASH' ) {
354                __merge_hash( $h1->{$k}, $h2->{$k}, ( $replace || 0 ) + 1 );
355            }
356            elsif ( ref $h1->{$k} eq 'ARRAY' ) {
357                if ( ref $h2->{$k} eq 'ARRAY' ) {
358                    push @{ $h1->{$k} }, @{ $h2->{$k} };
359                }
360                else {
361                    push @{ $h1->{$k} }, $h2->{$k};
362                }
363            }
364            else {
365                $h1->{$k} = [ $h1->{$k}, $h2->{$k} ];
366            }
367        }
368        else {
369            $h1->{$k} = $h2->{$k};
370        }
371    }
372}
373
374# The above functions can all be used to make MT objects (and subobjects).
375# The difference between them is characterized by these assertions:
376#
377#  $mt = MT::App::Search->new();
378#  assert($mt->isa('MT::App::Search'))
379#
380#  $mt1 = MT->instance
381#  $mt2 = MT->instance
382#  assert($mt1 == $mt2);
383#
384#  $mt1 = MT::App::CMS->construct()
385#  $mt2 = MT::App::CMS->construct()
386#  assert($mt1 != $mt2);
387#
388# TBD: make a test script for these.
389
390sub unplug {
391}
392
393sub config {
394    my $mt = shift;
395    ref $mt or $mt = MT->instance;
396    unless ( $mt->{cfg} ) {
397        require MT::ConfigMgr;
398        weaken( $mt->{cfg} = MT::ConfigMgr->instance );
399    }
400    if (@_) {
401        my $setting = shift;
402        @_ ? $mt->{cfg}->set( $setting, @_ ) : $mt->{cfg}->get($setting);
403    }
404    else {
405        $mt->{cfg};
406    }
407}
408
409sub request {
410    my $pkg  = shift;
411    my $inst = ref($pkg) ? $pkg : $pkg->instance;
412    unless ( $inst->{request} ) {
413        require MT::Request;
414        $inst->{request} = MT::Request->instance;
415    }
416    if (@_) {
417        $inst->{request}->stash(@_);
418    }
419    else {
420        $inst->{request};
421    }
422}
423
424sub log {
425    my $mt = shift;
426    unless ($plugins_installed) {
427        # finish init_schema here since we have to log something
428        # to the database.
429        $mt->init_schema();
430    }
431    my $msg;
432    if ( !@_ ) {    # single parameter to log, so $mt must be message
433        $msg = $mt;
434        $mt  = MT->instance;
435    }
436    else {          # multiple parameters to log; second one is message
437        $msg = shift;
438    }
439    my $log_class = $mt->model('log');
440    my $log = $log_class->new();
441    if ( ref $msg eq 'HASH' ) {
442        $log->set_values($msg);
443    }
444    elsif ( ( ref $msg ) && ( UNIVERSAL::isa( $msg, 'MT::Log' ) ) ) {
445        $log = $msg;
446    }
447    else {
448        $log->message($msg);
449    }
450    $log->level( MT::Log::INFO() )
451      unless defined $log->level;
452    $log->class('system')
453      unless defined $log->class;
454    $log->save();
455    print STDERR MT->translate( "Message: [_1]", $log->message ) . "\n"
456      if $MT::DebugMode;
457}
458my $plugin_full_path;
459
460sub run_tasks {
461    my $mt = shift;
462    require MT::TaskMgr;
463    MT::TaskMgr->run_tasks(@_);
464}
465
466sub add_plugin {
467    my $class = shift;
468    my ($plugin) = @_;
469    if ( ref $plugin eq 'HASH' ) {
470        require MT::Plugin;
471        $plugin = new MT::Plugin($plugin);
472    }
473    $plugin->{name} ||= $plugin_sig;
474    $plugin->{plugin_sig} = $plugin_sig;
475
476    my $id = $plugin->id;
477    unless ($plugin_envelope) {
478        warn "MT->add_plugin improperly called outside of MT plugin load loop.";
479        return;
480    }
481    $plugin->envelope($plugin_envelope);
482    Carp::confess("You cannot register multiple plugin objects from a single script. $plugin_sig")
483      if exists( $Plugins{$plugin_sig} )
484      && ( exists $Plugins{$plugin_sig}{object} );
485
486    $Components{ lc $id } = $plugin if $id;
487    $Plugins{$plugin_sig}{object} = $plugin;
488    $plugin->{full_path}  = $plugin_full_path;
489    $plugin->path($plugin_full_path);
490    unless ( $plugin->{registry} && ( %{ $plugin->{registry} } ) ) {
491        $plugin->{registry} = $plugin_registry;
492    }
493    if ( $plugin->{registry} ) {
494        if ( my $settings = $plugin->{registry}{config_settings} ) {
495            $settings = $plugin->{registry}{config_settings} = $settings->()
496              if ref($settings) eq 'CODE';
497            $class->config->define($settings);
498        }
499    }
500    push @Components, $plugin;
501    1;
502}
503
504our %CallbackAlias;
505our $CallbacksEnabled = 1;
506my %CallbacksEnabled;
507my @Callbacks;
508
509sub add_callback {
510    my $class = shift;
511    my ( $meth, $priority, $plugin, $code ) = @_;
512    if ( $meth =~ m/^(.+::)?([^\.]+)(\..+)?$/ ) {
513
514        # Remap (whatever)::(name).(something)
515        if ( exists $CallbackAlias{$2} ) {
516            $meth = $CallbackAlias{$2};
517            $meth = $1 . $meth if $1;
518            $meth = $meth . $3 if $3;
519        }
520    }
521    $meth = $CallbackAlias{$meth} if exists $CallbackAlias{$meth};
522    my $internal = 0;
523    if ( ref $plugin ) {
524        if ( ( defined $mt_inst ) && ( $plugin == $mt_inst ) ) {
525            $plugin   = undef;
526            $internal = 1;
527        }
528        elsif ( !UNIVERSAL::isa( $plugin, "MT::Component" ) ) {
529            return $class->trans_error(
530"If present, 3rd argument to add_callback must be an object of type MT::Component or MT::Plugin"
531            );
532        }
533    }
534    if ( ( ref $code ) ne 'CODE' ) {
535        if ( ref $code ) {
536            return $class->trans_error(
537                '4th argument to add_callback must be a CODE reference.');
538        }
539        else {
540            # Defer until callback is used
541            # if ($plugin) {
542            #     $code = MT->handler_to_coderef($code);
543            # }
544        }
545    }
546
547    # 0 and 11 are exclusive.
548    if ( $priority == 0 || $priority == 11 ) {
549        if ( $Callbacks[$priority]->{$meth} ) {
550            return $class->trans_error("Two plugins are in conflict");
551        }
552    }
553    return $class->trans_error( "Invalid priority level [_1] at add_callback",
554        $priority )
555      if ( ( $priority < 0 ) || ( $priority > 11 ) );
556    require MT::Callback;
557    $CallbacksEnabled{$meth} = 1;
558    ## push @{$Plugins{$plugin_sig}{callbacks}}, "$meth Callback" if $plugin_sig;
559    my $cb = new MT::Callback(
560        plugin   => $plugin,
561        code     => $code,
562        priority => $priority,
563        internal => $internal,
564        method   => $meth
565    );
566    push @{ $Callbacks[$priority]->{$meth} }, $cb;
567    $cb;
568}
569
570sub remove_callback {
571    my $class    = shift;
572    my ($cb)     = @_;
573    my $priority = $cb->{priority};
574    my $method   = $cb->{method};
575    my $list     = $Callbacks[$priority];
576    return unless $list;
577    my $cbarr = $list->{$method};
578    return unless $cbarr;
579    @$cbarr = grep { $_ != $cb } @$cbarr;
580}
581
582# For use by MT internal code
583sub _register_core_callbacks {
584    my $class = shift;
585    my ($callback_table) = @_;
586    foreach my $name ( keys %$callback_table ) {
587        $class->add_callback( $name, 5, $mt_inst, $callback_table->{$name} )
588          || return;
589    }
590    1;
591}
592
593sub register_callbacks {
594    my $class = shift;
595    my ($callback_list) = @_;
596    foreach my $cb (@$callback_list) {
597        $class->add_callback( $cb->{name}, $cb->{priority}, $cb->{plugin},
598            $cb->{code} )
599          || return;
600    }
601    1;
602}
603
604our $CB_ERR;
605sub callback_error { $CB_ERR = $_[0]; }
606sub callback_errstr { $CB_ERR }
607
608sub run_callback {
609    my $class = shift;
610    my ( $cb, @args ) = @_;
611
612    $cb->error();    # reset the error string
613    my $result = eval { $cb->invoke(@args) };
614    if ( my $err = $@ ) {
615        $cb->error($err);
616        my $plugin = $cb->{plugin};
617        my $name;
618        if ( $cb->{internal} ) {
619            $name = "Internal callback";
620        }
621        elsif ( UNIVERSAL::isa( $plugin, 'MT::Plugin' ) ) {
622            $name = $plugin->name() || MT->translate("Unnamed plugin");
623        }
624        else {
625            $name = MT->translate("Unnamed plugin");
626        }
627        require MT::Log;
628        MT->log(
629            {
630                message => MT->translate( "[_1] died with: [_2]", $name, $err ),
631                class   => 'system',
632                category => 'callback',
633                level    => MT::Log::ERROR(),
634            }
635        );
636        return 0;
637    }
638    if ( $cb->errstr() ) {
639        return 0;
640    }
641    return $result;
642}
643
644# A callback should return a true/false value. The result of
645# run_callbacks is the logical AND of all the callback's return
646# values. Some hookpoints will ignore the return value: e.g. object
647# callbacks don't use it. By convention, those that use it have Filter
648# at the end of their names (CommentPostFilter, CommentThrottleFilter,
649# etc.)
650# Note: this composition is not short-circuiting. All callbacks are
651# executed even if one has already returned false.
652# ALSO NOTE: failure (dying or setting $cb->errstr) does not force a
653# "false" return.
654# THINK: are there cases where a true value should override all false values?
655# that is, where logical OR is the right way to compose multiple callbacks?
656sub run_callbacks {
657    my $class = shift;
658    my ( $meth, @args ) = @_;
659    return 1 unless $CallbacksEnabled && %CallbacksEnabled;
660    $meth = $CallbackAlias{$meth} if exists $CallbackAlias{$meth};
661    my @methods;
662
663    # execution:
664    #   Full::Name.<variant>
665    #   *::Name.<variant> OR Name.<variant>
666    #   Full::Name
667    #   *::Name OR Name
668    push @methods, $meth if $CallbacksEnabled{$meth};    # bleh::blah variant
669    if ( $meth =~ /::/ ) {    # presence of :: implies it's an obj. cb
670        my $name = $meth;
671        $name =~ s/^.*::([^:]*)$/$1/;
672        $name = $CallbackAlias{ '*::' . $name }
673          if exists $CallbackAlias{ '*::' . $name };
674        push @methods, '*::' . $name
675          if $CallbacksEnabled{ '*::' . $name };    # *::blah variant
676        push @methods, $name if $CallbacksEnabled{$name};    # blah variant
677    }
678    if ( $meth =~ /\./ ) {    # presence of ' ' implies it is a variant callback
679        my ($name) = split /\./, $meth, 2;
680        $name = $CallbackAlias{$name} if exists $CallbackAlias{$name};
681        push @methods, $name if $CallbacksEnabled{$name};    # bleh::blah
682        if ( $name =~ m/::/ ) {
683            my $name2 = $name;
684            $name2 =~ s/^.*::([^:]*)$/$1/;
685            $name2 = $CallbackAlias{ '*::' . $name2 }
686              if exists $CallbackAlias{ '*::' . $name2 };
687            push @methods, '*::' . $name2
688              if $CallbacksEnabled{ '*::' . $name2 };        # *::blah
689            push @methods, $name2 if $CallbacksEnabled{$name2};    # blah
690        }
691    }
692    return 1 unless @methods;
693
694    $CallbacksEnabled{$_} = 0 for @methods;
695    my @errors;
696    my $filter_value = 1;
697    my $first_error;
698
699    foreach my $callback_sheaf (@Callbacks) {
700        for my $meth (@methods) {
701            if ( my $set = $callback_sheaf->{$meth} ) {
702                for my $cb (@$set) {
703                    my $result = $class->run_callback( $cb, @args );
704                    $filter_value &&= $result;
705                    if ( !$result ) {
706                        if ( $cb->errstr() ) {
707                            push @errors, $cb->errstr();
708                        }
709                        if ( !defined($first_error) ) {
710                            $first_error = $cb->errstr();
711                        }
712                    }
713                }
714            }
715        }
716    }
717
718    callback_error( join( '', @errors ) );
719
720    $CallbacksEnabled{$_} = 1 for @methods;
721    if ( !$filter_value ) {
722        return $class->error($first_error);
723    }
724    else {
725        return $filter_value;
726    }
727}
728
729sub user_class {
730    shift->{user_class};
731}
732
733sub find_config {
734    my $mt = shift;
735    my ($param) = @_;
736
737    $param->{Config}    ||= $ENV{MT_CONFIG};
738    $param->{Directory} ||= $ENV{MT_HOME};
739    if ( !$param->{Directory} ) {
740        if ( $param->{Config} ) {
741            $param->{Directory} = dirname( $param->{Config} );
742        }
743        else {
744            $param->{Directory} = dirname($0) || $ENV{PWD} || '.';
745        }
746    }
747
748    # the directory is the more important parameter between it and
749    # the config parameter. if config is unreadable, then scan for
750    # a config file using the directory as a base.  we support
751    # either mt.cfg or mt-config.cgi for the config file name. the
752    # latter being a more secure choice since it is unreadable from
753    # a browser.
754    for my $cfg_file ( $param->{Config},
755        File::Spec->catfile( $param->{Directory}, 'mt-config.cgi' ),
756        'mt-config.cgi' )
757    {
758        return $cfg_file if $cfg_file && -r $cfg_file && -f $cfg_file;
759    }
760    return undef;
761}
762
763sub init_schema {
764    require MT::Object;
765    MT::Object->install_pre_init_properties();
766}
767
768sub init_permissions {
769    require MT::Permission;
770    MT::Permission->init_permissions;
771}
772
773sub init_config {
774    my $mt = shift;
775    my ($param) = @_;
776
777    my $cfg_file = $mt->find_config($param);
778    return $mt->error(
779"Missing configuration file. Maybe you forgot to move mt-config.cgi-original to mt-config.cgi?"
780    ) unless $cfg_file;
781    $cfg_file = File::Spec->rel2abs($cfg_file);
782
783    # translate the config file's location to an absolute path, so we
784    # can use that directory as a basis for calculating other relative
785    # paths found in the config file.
786    my $config_dir = $mt->{config_dir} = dirname($cfg_file);
787
788    # store the mt_dir (home) as an absolute path; fallback to the config
789    # directory if it isn't set.
790    $mt->{mt_dir} =
791      $param->{Directory}
792      ? File::Spec->rel2abs( $param->{Directory} )
793      : $mt->{config_dir};
794    $mt->{mt_dir} ||= dirname($0);
795
796    # also make note of the active application path; this is derived by
797    # checking the PWD environment variable, the dirname of $0,
798    # the directory of SCRIPT_FILENAME and lastly, falls back to mt_dir
799    $mt->{app_dir} = $ENV{PWD} || "";
800    $mt->{app_dir} = dirname($0)
801      if !$mt->{app_dir}
802      || !File::Spec->file_name_is_absolute( $mt->{app_dir} );
803    $mt->{app_dir} = dirname( $ENV{SCRIPT_FILENAME} )
804      if $ENV{SCRIPT_FILENAME}
805      && ( !$mt->{app_dir}
806        || ( !File::Spec->file_name_is_absolute( $mt->{app_dir} ) ) );
807    $mt->{app_dir} ||= $mt->{mt_dir};
808    $mt->{app_dir} = File::Spec->rel2abs( $mt->{app_dir} );
809
810    my $cfg = $mt->config;
811    $cfg->define( $mt->registry('config_settings') );
812    $cfg->read_config($cfg_file) or return $mt->error( $cfg->errstr );
813    $mt->{cfg_file} = $cfg_file;
814
815    my @mt_paths = $cfg->paths;
816    for my $meth (@mt_paths) {
817        my $path = $cfg->get( $meth, undef );
818        my $type = $cfg->type($meth);
819        if ( defined $path ) {
820            if ( $type eq 'ARRAY' ) {
821                my @paths = $cfg->get($meth);
822                local $_;
823                foreach (@paths) {
824                    next if File::Spec->file_name_is_absolute($_);
825                    $_ = File::Spec->catfile( $config_dir, $_ );
826                }
827                $cfg->$meth( \@paths );
828            }
829            else {
830                if ( !File::Spec->file_name_is_absolute($path) ) {
831                    $path = File::Spec->catfile( $config_dir, $path );
832                    $cfg->$meth($path);
833                }
834            }
835        }
836        else {
837            next if $type eq 'ARRAY';
838            my $path = $cfg->default($meth);
839            if ( defined $path ) {
840                $cfg->$meth( File::Spec->catfile( $config_dir, $path ) );
841            }
842        }
843    }
844
845    return $mt->trans_error("Bad ObjectDriver config")
846      unless $cfg->ObjectDriver;
847
848    if ( $MT::DebugMode = $cfg->DebugMode ) {
849        require Data::Dumper;
850        $Data::Dumper::Terse    = 1;
851        $Data::Dumper::Maxdepth = 4;
852        $Data::Dumper::Sortkeys = 1;
853        $Data::Dumper::Indent   = 1;
854    }
855
856    if ($cfg->PerformanceLogging && $cfg->ProcessMemoryCommand) {
857        $mt->log_times();
858    }
859
860    $mt->set_language( $cfg->DefaultLanguage );
861
862    my $cgi_path = $cfg->CGIPath;
863    if ( !$cgi_path || $cgi_path =~ m!http://www\.example\.com/! ) {
864        return $mt->trans_error("Bad CGIPath config");
865    }
866
867    $mt->{cfg} = $cfg;
868
869    1;
870}
871
872{
873my ($memory_start);
874sub log_times {
875    my $pkg = shift;
876
877    my $timer = $pkg->get_timer;
878    return unless $timer;
879
880    my $memory;
881    my $cmd = $pkg->config->ProcessMemoryCommand;
882    if ($cmd) {
883        my $re;
884        if (ref($cmd) eq 'HASH') {
885            $re = $cmd->{regex};
886            $cmd = $cmd->{command};
887        }
888        $cmd =~ s/\$\$/$$/g;
889        $memory = `$cmd`;
890        if ($re) {
891            if ($memory =~ m/$re/) {
892                $memory = $1;
893                $memory =~ s/\D//g;
894            }
895        } else {
896            $memory =~ s/\s+//gs;
897        }
898    }
899
900    # Called at the start of the process; so we're only recording
901    # the memory usage at the start of the app right now.
902    unless ($timer->{elapsed}) {
903        $memory_start = $memory;
904        return;
905    }
906
907    my $log_file;
908
909    # Log filename calcluation; changes daily, so we don't cache this
910    require File::Spec;
911    my $dir = File::Spec->catdir( MT->instance->static_file_path,
912        'support', 'logs');
913    if (! -d $dir) {
914        require File::Path;
915        eval { File::Path::mkpath([$dir], 0, 0777) };
916        if ($@) {
917            $log_file = 0;
918            return;
919        }
920    }
921    my @time = localtime(time);
922    my $file = sprintf("pl-%04d%02d%02d.log", $time[5] + 1900, $time[4]+1, $time[3]);
923    $log_file = File::Spec->catfile( $dir, $file );
924
925    my $first_write = ! -f $log_file;
926
927    local *PERFLOG;
928    open PERFLOG, ">>$log_file";
929    require Fcntl;
930    flock(PERFLOG, Fcntl::LOCK_EX());
931
932    if ($first_write) {
933        require Config;
934        my ($osname, $osvers) = ($Config::Config{osname}, $Config::Config{osvers});
935        print PERFLOG "# Operating System: $osname/$osvers\n";
936        print PERFLOG "# Platform: $^O\n";
937        my $ver = ref($^V) eq 'version' ? $^V->normal : ( $^V ? join('.', unpack 'C*', $^V) : $] );
938        print PERFLOG "# Perl Version: $ver\n";
939        print PERFLOG "# Web Server: $ENV{SERVER_SOFTWARE}\n";
940        require MT::Object;
941        my $driver = MT::Object->driver;
942        if ($driver) {
943            my $dbh = $driver->r_handle;
944            if ($dbh) {
945                my $dbname = $dbh->get_info( 17 ); # SQL_DBMS_NAME
946                my $dbver = $dbh->get_info( 18 ); # SQL_DBMS_VER
947                if ($dbname && $dbver) {
948                    print PERFLOG "# Database: $dbname/$dbver\n";
949                }
950            }
951        }
952        my ($drname, $drh) = each %DBI::installed_drh;
953        print PERFLOG "# Database Library: DBI/" . $DBI::VERSION . "; DBD/" . $drh->{Version} . "\n";
954        if ($ENV{MOD_PERL}) {
955            print PERFLOG "# App Mode: mod_perl\n";
956        }
957        elsif ($ENV{FAST_CGI}) {
958            print PERFLOG "# App Mode: FastCGI\n";
959        }
960        else {
961            print PERFLOG "# App Mode: CGI\n";
962        }
963    }
964
965    if ($memory) {
966        print PERFLOG $timer->dump_line("mem_start=$memory_start", "mem_end=$memory");
967    } else {
968        print PERFLOG $timer->dump_line();
969    }
970
971    close PERFLOG;
972}
973}
974
975sub get_timer {
976    my $mt = shift;
977    $mt = MT->instance unless ref $mt;
978    my $timer = $mt->request('timer');
979    unless ($timer) {
980        my $uri;
981        if ($mt->isa('MT::App')) {
982            $uri = $mt->uri( args => { $mt->param_hash } );
983        }
984        require MT::Util::ReqTimer;
985        $timer = MT::Util::ReqTimer->new( $uri );
986        $mt->request('timer', $timer);
987    }
988    return $timer;
989}
990
991sub time_this {
992    my $mt = shift;
993    my ($str, $code) = @_;
994    my $timer = $mt->get_timer();
995    my $ret;
996    if ($timer) {
997        $timer->pause_partial();
998        $ret = $code->();
999        $timer->mark($str);
1000    } else {
1001        $ret = $code->();
1002    }
1003    return $ret;
1004}
1005
1006sub init_config_from_db {
1007    my $mt = shift;
1008    my ($param) = @_;
1009    my $cfg = $mt->config;
1010    $cfg->read_config_db();
1011
1012    # Tell any instantiated drivers to reconfigure themselves as necessary
1013    MT::ObjectDriverFactory->configure;
1014
1015    1;
1016}
1017
1018sub bootstrap {
1019    my $pkg = shift;
1020    $pkg->init_paths() or return;
1021    $pkg->init_core()  or return;
1022}
1023
1024sub init_paths {
1025    my $mt = shift;
1026    my ($param) = @_;
1027
1028    # determine MT directory
1029    my ($orig_dir);
1030    require File::Spec;
1031    if ( !( $MT_DIR = $ENV{MT_HOME} ) ) {
1032        if ( $0 =~ m!(.*([/\\]))! ) {
1033            $orig_dir = $MT_DIR = $1;
1034            my $slash = $2;
1035            $MT_DIR =~ s!(?:[/\\]|^)(?:plugins[/\\].*|tools[/\\])$!$slash!;
1036            $MT_DIR = '' if ( $MT_DIR =~ m!^\.?[\\/]$! );
1037        }
1038        else {
1039
1040            # MT_DIR/lib/MT.pm -> MT_DIR/lib -> MT_DIR
1041            $MT_DIR = dirname( dirname( File::Spec->rel2abs(__FILE__) ) );
1042        }
1043        unless ($MT_DIR) {
1044            $orig_dir = $MT_DIR = $ENV{PWD} || '.';
1045            $MT_DIR =~ s!(?:[/\\]|^)(?:plugins[/\\].*|tools[/\\]?)$!!;
1046        }
1047        $ENV{MT_HOME} = $MT_DIR;
1048    }
1049    unshift @INC, File::Spec->catdir( $MT_DIR,   'extlib' );
1050    unshift @INC, File::Spec->catdir( $orig_dir, 'lib' )
1051      if $orig_dir && ( $orig_dir ne $MT_DIR );
1052
1053    $mt->set_language('__BUILD_LANGUAGE__');
1054
1055    if ( my $cfg_file = $mt->find_config($param) ) {
1056        $cfg_file = File::Spec->rel2abs($cfg_file);
1057        $CFG_FILE = $cfg_file;
1058    }
1059    else {
1060        return $mt->trans_error(
1061"Missing configuration file. Maybe you forgot to move mt-config.cgi-original to mt-config.cgi?"
1062        ) if ref($mt);
1063    }
1064
1065    # store the mt_dir (home) as an absolute path; fallback to the config
1066    # directory if it isn't set.
1067    $MT_DIR ||=
1068      $param->{directory}
1069      ? File::Spec->rel2abs( $param->{directory} )
1070      : $CFG_DIR;
1071    $MT_DIR ||= dirname($0);
1072
1073    # also make note of the active application path; this is derived by
1074    # checking the PWD environment variable, the dirname of $0,
1075    # the directory of SCRIPT_FILENAME and lastly, falls back to mt_dir
1076    $APP_DIR = $ENV{PWD} || "";
1077    $APP_DIR = dirname($0)
1078      if !$APP_DIR || !File::Spec->file_name_is_absolute($APP_DIR);
1079    $APP_DIR = dirname( $ENV{SCRIPT_FILENAME} )
1080      if $ENV{SCRIPT_FILENAME}
1081      && ( !$APP_DIR || ( !File::Spec->file_name_is_absolute($APP_DIR) ) );
1082    $APP_DIR ||= $MT_DIR;
1083    $APP_DIR = File::Spec->rel2abs($APP_DIR);
1084
1085    return 1;
1086}
1087
1088sub init_core {
1089    my $mt = shift;
1090    return if exists $Components{'core'};
1091    require MT::Core;
1092    my $c = MT::Core->new( { id => 'core', path => $MT_DIR } )
1093      or die MT::Core->errstr;
1094    $Components{'core'} = $c;
1095
1096    # Additional locale-specific defaults
1097    my $defaults = $c->{registry}{config_settings};
1098    $defaults->{DefaultLanguage}{default} = '__BUILD_LANGUAGE__';
1099    $defaults->{NewsboxURL}{default} = '__NEWSBOX_URL__';
1100    $defaults->{LearningNewsURL}{default} = '__LEARNINGNEWS_URL__';
1101    $defaults->{SupportURL}{default} = '__SUPPORT_URL__';
1102    $defaults->{NewsURL}{default} = '__NEWS_URL__';
1103    #$defaults->{HelpURL}{default} = '__HELP_URL__';
1104    $defaults->{DefaultTimezone}{default} = '__DEFAULT_TIMEZONE__';
1105    $defaults->{TimeOffset}{default} = '__DEFAULT_TIMEZONE__';
1106    $defaults->{MailEncoding}{default} = '__MAIL_ENCODING__';
1107    $defaults->{ExportEncoding}{default} = '__EXPORT_ENCODING__';
1108    $defaults->{LogExportEncoding}{default} = '__LOG_EXPORT_ENCODING__';
1109    $defaults->{CategoryNameNodash}{default} = '__CATEGORY_NAME_NODASH__';
1110    $defaults->{PublishCharset}{default} = '__PUBLISH_CHARSET__';
1111
1112    push @Components, $c;
1113    return 1;
1114}
1115
1116sub init {
1117    my $mt    = shift;
1118    my %param = @_;
1119
1120    $mt->bootstrap() unless $MT_DIR;
1121    $mt->{mt_dir}     = $MT_DIR;
1122    $mt->{config_dir} = $CFG_DIR;
1123    $mt->{app_dir}    = $APP_DIR;
1124
1125    $mt->init_callbacks();
1126
1127    ## Initialize the language to the default in case any errors occur in
1128    ## the rest of the initialization process.
1129    $mt->init_config( \%param ) or return;
1130    $mt->init_addons(@_)       or return;
1131    $mt->init_config_from_db( \%param ) or return;
1132    $mt->init_plugins(@_)       or return;
1133    $plugins_installed = 1;
1134    $mt->init_schema();
1135    $mt->init_permissions();
1136
1137    # Load MT::Log so constants are available
1138    require MT::Log;
1139
1140    return $mt;
1141}
1142
1143sub init_callbacks {
1144    my $mt = shift;
1145    MT->_register_core_callbacks({
1146        'build_file_filter' => sub { MT->publisher->queue_build_file_filter(@_) },
1147        'cms_upload_file' => \&core_upload_file_to_sync,
1148        'api_upload_file' => \&core_upload_file_to_sync,
1149    });
1150}
1151
1152sub core_upload_file_to_sync {
1153    my ($cb, %args) = @_;
1154    MT->upload_file_to_sync(%args);
1155}
1156
1157sub upload_file_to_sync {
1158    my $class = shift;
1159    my (%args) = @_;
1160
1161    # no need to do this unless we're syncing stuff.
1162    return unless MT->config('SyncTarget');
1163
1164    my $url = $args{url};
1165    my $file = $args{file};
1166    return unless -f $file;
1167
1168    my $blog = $args{blog};
1169    my $blog_id = $blog->id;
1170    return unless $blog->publish_queue;
1171
1172    require MT::FileInfo;
1173    my $base_url = $url;
1174    $base_url =~ s!^https?://[^/]+!!;
1175    my $fi = MT::FileInfo->load({ blog_id => $blog_id, url => $base_url });
1176    if (!$fi) {
1177        $fi = new MT::FileInfo;
1178        $fi->blog_id($blog_id);
1179        $fi->url($base_url);
1180        $fi->file_path($file);
1181    } else {
1182        $fi->file_path($file);
1183    }
1184    $fi->save;
1185
1186    require MT::TheSchwartz;
1187    require TheSchwartz::Job;
1188    my $job = TheSchwartz::Job->new();
1189    $job->funcname('MT::Worker::Sync');
1190    $job->uniqkey( $fi->id );
1191    $job->coalesce( ( $fi->blog_id || 0 ) . ':' . $$ . ':' . ( time - ( time % 10 ) ) );
1192    MT::TheSchwartz->insert($job);
1193}
1194
1195sub init_addons {
1196    my $mt = shift;
1197    my $cfg = $mt->config;
1198    my @PluginPaths;
1199
1200    unshift @PluginPaths, File::Spec->catdir( $MT_DIR, 'addons' );
1201    return $mt->_init_plugins_core({}, 1, \@PluginPaths);
1202}
1203
1204sub init_plugins {
1205    my $mt = shift;
1206
1207    # Load compatibility module for prior version
1208    # This should always be MT::Compat::v(MAJOR_RELEASE_VERSION - 1).
1209    require MT::Compat::v3;
1210
1211    require MT::Plugin;
1212    my $cfg          = $mt->config;
1213    my $use_plugins  = $cfg->UsePlugins;
1214    my @PluginPaths  = $cfg->PluginPath;
1215    my $PluginSwitch = $cfg->PluginSwitch || {};
1216    return $mt->_init_plugins_core($PluginSwitch, $use_plugins, \@PluginPaths);
1217}
1218
1219sub _init_plugins_core {
1220    my $mt = shift;
1221    my ($PluginSwitch, $use_plugins, $PluginPaths) = @_;
1222
1223    my $timer;
1224    if ($mt->config->PerformanceLogging) {
1225        $timer = $mt->get_timer();
1226    }
1227
1228    foreach my $PluginPath (@$PluginPaths) {
1229        my $plugin_lastdir = $PluginPath;
1230        $plugin_lastdir =~ s![\\/]$!!;
1231        $plugin_lastdir =~ s!.*[\\/]!!;
1232        local *DH;
1233        if ( opendir DH, $PluginPath ) {
1234            my @p = readdir DH;
1235          PLUGIN:
1236            for my $plugin (@p) {
1237                next if ( $plugin =~ /^\.\.?$/ || $plugin =~ /~$/ );
1238
1239                my $load_plugin = sub {
1240                    my ( $plugin, $sig ) = @_;
1241                    die "Bad plugin filename '$plugin'"
1242                      if ( $plugin !~ /^([-\\\/\@\:\w\.\s~]+)$/ );
1243                    local $plugin_sig      = $sig;
1244                    local $plugin_registry = {};
1245                    $plugin = $1;
1246                    if (
1247                        !$use_plugins
1248                        || ( exists $PluginSwitch->{$plugin_sig}
1249                            && !$PluginSwitch->{$plugin_sig} )
1250                      )
1251                    {
1252                        $Plugins{$plugin_sig}{full_path} = $plugin_full_path;
1253                        $Plugins{$plugin_sig}{enabled}   = 0;
1254                        return 0;
1255                    }
1256                    return 0 if exists $Plugins{$plugin_sig};
1257                    $Plugins{$plugin_sig}{full_path} = $plugin_full_path;
1258                    $timer->pause_partial if $timer;
1259                    eval { require $plugin };
1260                    $timer->mark("Loaded plugin " . $sig) if $timer;
1261                    if ($@) {
1262                        $Plugins{$plugin_sig}{error} = $@;
1263                        # Issue MT log within another eval block in the
1264                        # event that the plugin error is happening before
1265                        # the database has been initialized...
1266                        eval {
1267                            require MT::Log;
1268                            $mt->log(
1269                                {
1270                                    message => $mt->translate(
1271                                        "Plugin error: [_1] [_2]", $plugin,
1272                                        $Plugins{$plugin_sig}{error}
1273                                    ),
1274                                    class => 'system',
1275                                    level => MT::Log::ERROR()
1276                                }
1277                            );
1278                        };
1279                        return 0;
1280                    }
1281                    else {
1282                        if ( my $obj = $Plugins{$plugin_sig}{object} ) {
1283                            $obj->init_callbacks();
1284                        }
1285                        else {
1286
1287                            # A plugin did not register itself, so
1288                            # create a dummy plugin object which will
1289                            # cause it to show up in the plugin listing
1290                            # by it's filename.
1291                            MT->add_plugin( {} );
1292                        }
1293                    }
1294                    $Plugins{$plugin_sig}{enabled} = 1;
1295                    return 1;
1296                };
1297                $plugin_full_path = File::Spec->catfile( $PluginPath, $plugin );
1298                if ( -f $plugin_full_path ) {
1299                    $plugin_envelope = $plugin_lastdir;
1300                    $load_plugin->( $plugin_full_path, $plugin )
1301                      if $plugin_full_path =~ /\.pl$/;
1302                }
1303                else {
1304                    my $plugin_dir = $plugin;
1305                    $plugin_envelope = "$plugin_lastdir/" . $plugin;
1306
1307                    # handle config.yaml
1308                    my $yaml =
1309                      File::Spec->catdir( $plugin_full_path, 'config.yaml' );
1310                    my $libdir;
1311                    ( unshift @INC, $libdir )
1312                      if -d ( $libdir =
1313                          File::Spec->catdir( $plugin_full_path, 'lib' ) );
1314                    if ( -f $yaml ) {
1315                        my $pclass =
1316                          $plugin_dir =~ m/\.pack$/
1317                          ? 'MT::Component'
1318                          : 'MT::Plugin';
1319
1320                        # Don't process disabled plugin config.yaml files.
1321                        if (
1322                            $pclass eq 'MT::Plugin'
1323                            && (
1324                                !$use_plugins
1325                                || ( exists $PluginSwitch->{$plugin_dir}
1326                                    && !$PluginSwitch->{$plugin_dir} )
1327                            )
1328                          )
1329                        {
1330                            $Plugins{$plugin_dir}{full_path} =
1331                              $plugin_full_path;
1332                            $Plugins{$plugin_dir}{enabled} = 0;
1333                            next;
1334                        }
1335                        my $id = lc $plugin_dir;
1336                        $id =~ s/\.\w+$//;
1337                        my $p = $pclass->new(
1338                            {
1339                                id       => $id,
1340                                path     => $plugin_full_path,
1341                                envelope => $plugin_envelope
1342                            }
1343                        );
1344
1345                        # rebless? based on config?
1346                        local $plugin_sig = $plugin_dir;
1347                        MT->add_plugin($p);
1348                        $p->init_callbacks()
1349                            if $pclass eq 'MT::Plugin';
1350                        next;
1351                    }
1352
1353                    opendir SUBDIR, $plugin_full_path;
1354                    my @plugins = readdir SUBDIR;
1355                    closedir SUBDIR;
1356                    for my $plugin (@plugins) {
1357                        next if $plugin !~ /\.pl$/;
1358                        my $plugin_file =
1359                          File::Spec->catfile( $plugin_full_path, $plugin );
1360                        if ( -f $plugin_file ) {
1361                            $load_plugin->(
1362                                $plugin_file, $plugin_dir . '/' . $plugin
1363                            );
1364                        }
1365                    }
1366                }
1367            }
1368            closedir DH;
1369        }
1370    }
1371
1372    # Reset the Text_filters hash in case it was preloaded by plugins by
1373    # calling all_text_filters (Markdown in particular does this).
1374    # Upon calling all_text_filters again, it will be properly loaded by
1375    # querying the registry.
1376    %Text_filters = ();
1377
1378    1;
1379}
1380
1381my %addons;
1382
1383sub find_addons {
1384    my $mt = shift;
1385    my ($type) = @_;
1386
1387    unless (%addons) {
1388        my $addon_path = File::Spec->catdir( $MT_DIR, 'addons' );
1389        local *DH;
1390        if ( opendir DH, $addon_path ) {
1391            my @p = readdir DH;
1392            foreach my $p (@p) {
1393                next if $p eq '.' || $p eq '..';
1394                my $full_path = File::Spec->catdir( $addon_path, $p );
1395                if ( -d $full_path ) {
1396                    if ( $p =~ m/^(.+)\.(\w+)$/ ) {
1397                        my $label = $1;
1398                        my $id    = lc $1;
1399                        my $type  = $2;
1400                        if ( $type eq 'pack' ) {
1401                            $label .= ' Pack';
1402                        }
1403                        elsif ( $type eq 'theme' ) {
1404                            $label .= ' Theme';
1405                        }
1406                        elsif ( $type eq 'plugin' ) {
1407                            $label .= ' Plugin';
1408                        }
1409                        push @{ $addons{$type} },
1410                          {
1411                            label    => $label,
1412                            id       => $id,
1413                            envelope => 'addons/' . $p . '/',
1414                            path     => $full_path,
1415                          };
1416                    }
1417                }
1418            }
1419        }
1420    }
1421    if ($type) {
1422        my $addons = $addons{$type} ||= [];
1423        return $addons;
1424    }
1425    return 1;
1426}
1427
1428*mt_dir = \&server_path;
1429sub server_path { $_[0]->{mt_dir} }
1430sub app_dir     { $_[0]->{app_dir} }
1431sub config_dir  { $_[0]->{config_dir} }
1432
1433sub component {
1434    my $mt = shift;
1435    my ($id) = @_;
1436    return $Components{ lc $id };
1437}
1438
1439sub publisher {
1440    my $mt = shift;
1441    $mt = $mt->instance unless ref $mt;
1442    unless ( $mt->{WeblogPublisher} ) {
1443        require MT::WeblogPublisher;
1444        $mt->{WeblogPublisher} = new MT::WeblogPublisher();
1445    }
1446    $mt->{WeblogPublisher};
1447}
1448
1449sub rebuild {
1450    my $mt = shift;
1451    $mt->publisher->rebuild(@_)
1452      or return $mt->error( $mt->publisher->errstr );
1453}
1454
1455sub rebuild_entry {
1456    my $mt = shift;
1457    $mt->publisher->rebuild_entry(@_)
1458      or return $mt->error( $mt->publisher->errstr );
1459}
1460
1461sub rebuild_indexes {
1462    my $mt = shift;
1463    $mt->publisher->rebuild_indexes(@_)
1464      or return $mt->error( $mt->publisher->errstr );
1465}
1466
1467sub rebuild_archives {
1468    my $mt = shift;
1469    $mt->publisher->rebuild_archives(@_)
1470      or return $mt->error( $mt->publisher->errstr );
1471}
1472
1473sub ping {
1474    my $mt    = shift;
1475    my %param = @_;
1476    my $blog;
1477    require MT::Entry;
1478    require MT::Util;
1479    unless ( $blog = $param{Blog} ) {
1480        my $blog_id = $param{BlogID};
1481        $blog = MT::Blog->load($blog_id)
1482          or return $mt->trans_error( "Load of blog '[_1]' failed: [_2]",
1483            $blog_id, MT::Blog->errstr );
1484    }
1485
1486    my (@res);
1487
1488    my $send_updates = 1;
1489    if ( exists $param{OldStatus} ) {
1490        ## If this is a new entry (!$old_status) OR the status was previously
1491        ## set to draft, and is now set to publish, send the update pings.
1492        my $old_status = $param{OldStatus};
1493        if ( $old_status && $old_status eq MT::Entry::RELEASE() ) {
1494            $send_updates = 0;
1495        }
1496    }
1497
1498    if ( $send_updates && !( MT->config->DisableNotificationPings ) ) {
1499        ## Send update pings.
1500        my @updates = $mt->update_ping_list($blog);
1501        for my $url (@updates) {
1502            require MT::XMLRPC;
1503            if ( MT::XMLRPC->ping_update( 'weblogUpdates.ping', $blog, $url ) )
1504            {
1505                push @res, { good => 1, url => $url, type => "update" };
1506            }
1507            else {
1508                push @res,
1509                  {
1510                    good  => 0,
1511                    url   => $url,
1512                    type  => "update",
1513                    error => MT::XMLRPC->errstr
1514                  };
1515            }
1516        }
1517        if ( $blog->mt_update_key ) {
1518            require MT::XMLRPC;
1519            if ( MT::XMLRPC->mt_ping($blog) ) {
1520                push @res,
1521                  {
1522                    good => 1,
1523                    url  => $mt->{cfg}->MTPingURL,
1524                    type => "update"
1525                  };
1526            }
1527            else {
1528                push @res,
1529                  {
1530                    good  => 0,
1531                    url   => $mt->{cfg}->MTPingURL,
1532                    type  => "update",
1533                    error => MT::XMLRPC->errstr
1534                  };
1535            }
1536        }
1537    }
1538
1539    my $cfg     = $mt->{cfg};
1540    my $send_tb = $cfg->OutboundTrackbackLimit;
1541    return \@res if $send_tb eq 'off';
1542
1543    my @tb_domains;
1544    if ( $send_tb eq 'selected' ) {
1545        @tb_domains = $cfg->OutboundTrackbackDomains;
1546    }
1547    elsif ( $send_tb eq 'local' ) {
1548        my $iter = MT::Blog->load_iter();
1549        while ( my $b = $iter->() ) {
1550            next if $b->id == $blog->id;
1551            push @tb_domains, MT::Util::extract_domains( $b->site_url );
1552        }
1553    }
1554    my $tb_domains;
1555    if (@tb_domains) {
1556        $tb_domains = '';
1557        my %seen;
1558        local $_;
1559        foreach (@tb_domains) {
1560            next unless $_;
1561            $_ = lc($_);
1562            next if $seen{$_};
1563            $tb_domains .= '|' if $tb_domains ne '';
1564            $tb_domains .= quotemeta($_);
1565            $seen{$_} = 1;
1566        }
1567        $tb_domains = '(' . $tb_domains . ')' if $tb_domains;
1568    }
1569
1570    ## Send TrackBack pings.
1571    if ( my $entry = $param{Entry} ) {
1572        my $pings = $entry->to_ping_url_list;
1573
1574        my %pinged = map { $_ => 1 } @{ $entry->pinged_url_list };
1575        my $cats = $entry->categories;
1576        for my $cat (@$cats) {
1577            push @$pings, grep !$pinged{$_}, @{ $cat->ping_url_list };
1578        }
1579
1580        my $ua = MT->new_ua;
1581
1582        ## Build query string to be sent on each ping.
1583        my @qs;
1584        push @qs, 'title=' . MT::Util::encode_url( $entry->title );
1585        push @qs, 'url=' . MT::Util::encode_url( $entry->permalink );
1586        push @qs, 'excerpt=' . MT::Util::encode_url( $entry->get_excerpt );
1587        push @qs, 'blog_name=' . MT::Util::encode_url( $blog->name );
1588        my $qs = join '&', @qs;
1589
1590        ## Character encoding--best guess.
1591        my $enc = $mt->{cfg}->PublishCharset;
1592
1593        for my $url (@$pings) {
1594            $url =~ s/^\s*//;
1595            $url =~ s/\s*$//;
1596            my $url_domain;
1597            ($url_domain) = MT::Util::extract_domains($url);
1598            next if $tb_domains && lc($url_domain) !~ m/$tb_domains$/;
1599
1600            my $req = HTTP::Request->new( POST => $url );
1601            $req->content_type(
1602                "application/x-www-form-urlencoded; charset=$enc");
1603            $req->content($qs);
1604            my $res = $ua->request($req);
1605            if ( substr( $res->code, 0, 1 ) eq '2' ) {
1606                my $c = $res->content;
1607                my ( $error, $msg ) =
1608                  $c =~ m!<error>(\d+).*<message>(.+?)</message>!s;
1609                if ($error) {
1610                    push @res,
1611                      {
1612                        good  => 0,
1613                        url   => $url,
1614                        type  => 'trackback',
1615                        error => $msg
1616                      };
1617                }
1618                else {
1619                    push @res, { good => 1, url => $url, type => 'trackback' };
1620                }
1621            }
1622            else {
1623                push @res,
1624                  {
1625                    good  => 0,
1626                    url   => $url,
1627                    type  => 'trackback',
1628                    error => "HTTP error: " . $res->status_line
1629                  };
1630            }
1631        }
1632    }
1633    \@res;
1634}
1635
1636sub ping_and_save {
1637    my $mt    = shift;
1638    my %param = @_;
1639    if ( my $entry = $param{Entry} ) {
1640        my $results = MT::ping( $mt, @_ ) or return;
1641        my %still_ping;
1642        my $pinged = $entry->pinged_url_list;
1643        for my $res (@$results) {
1644            next if $res->{type} ne 'trackback';
1645            if ( !$res->{good} ) {
1646                $still_ping{ $res->{url} } = 1;
1647            }
1648            push @$pinged,
1649              $res->{url}
1650              . ( $res->{good}
1651                ? ''
1652                : ' ' . MT::I18N::encode_text( $res->{error} ) );
1653        }
1654        $entry->pinged_urls( join "\n", @$pinged );
1655        $entry->to_ping_urls( join "\n", keys %still_ping );
1656        $entry->save or return $mt->error( $entry->errstr );
1657        return $results;
1658    }
1659    1;
1660}
1661
1662sub needs_ping {
1663    my $mt    = shift;
1664    my %param = @_;
1665    my $blog  = $param{Blog};
1666    my $entry = $param{Entry};
1667    require MT::Entry;
1668    return unless $entry->status == MT::Entry::RELEASE();
1669    my $old_status = $param{OldStatus};
1670    my %list;
1671    ## If this is a new entry (!$old_status) OR the status was previously
1672    ## set to draft, and is now set to publish, send the update pings.
1673    if ( ( !$old_status || $old_status ne MT::Entry::RELEASE() )
1674        && !( MT->config->DisableNotificationPings ) )
1675    {
1676        my @updates = $mt->update_ping_list($blog);
1677        @list{@updates} = (1) x @updates;
1678        $list{ $mt->{cfg}->MTPingURL } = 1 if $blog && $blog->mt_update_key;
1679    }
1680    if ($entry) {
1681        @list{ @{ $entry->to_ping_url_list } } = ();
1682        my %pinged = map { $_ => 1 } @{ $entry->pinged_url_list };
1683        my $cats = $entry->categories;
1684        for my $cat (@$cats) {
1685            @list{ grep !$pinged{$_}, @{ $cat->ping_url_list } } = ();
1686        }
1687    }
1688    my @list = keys %list;
1689    return unless @list;
1690    \@list;
1691}
1692
1693sub update_ping_list {
1694    my $mt = shift;
1695    my ($blog) = @_;
1696
1697    my @updates;
1698    if ( my $pings = MT->registry('ping_servers') ) {
1699        my $up = $blog->update_pings;
1700        if ($up) {
1701            foreach ( split ',', $up ) {
1702                next unless exists $pings->{$_};
1703                push @updates, $pings->{$_}->{url};
1704            }
1705        }
1706    }
1707    if ( my $others = $blog->ping_others ) {
1708        push @updates, split /\r?\n/, $others;
1709    }
1710    my %updates;
1711    for my $url (@updates) {
1712        for ($url) {
1713            s/^\s*//;
1714            s/\s*$//;
1715        }
1716        next unless $url =~ /\S/;
1717        $updates{$url}++;
1718    }
1719    keys %updates;
1720}
1721
1722{
1723    my $LH;
1724
1725    sub set_language {
1726        my $pkg = shift;
1727        require MT::L10N;
1728        $LH = MT::L10N->get_handle(@_);
1729
1730        # Clear any l10n_handles in request
1731        $pkg->request( 'l10n_handle', {} );
1732        return $LH;
1733    }
1734
1735    require MT::I18N;
1736
1737    sub translate {
1738        my $this = shift;
1739        my $app = ref($this) ? $this : $this->app;
1740        if ( $app->{component} ) {
1741            if ( my $c = $app->component( $app->{component} ) ) {
1742                local $app->{component} = undef;
1743                return $c->translate(@_);
1744            }
1745        }
1746        my ( $format, @args ) = @_;
1747        foreach (@args) {
1748            $_ = $_->() if ref($_) eq 'CODE';
1749        }
1750        my $enc = MT->instance->config('PublishCharset') || 'utf-8';
1751        return $LH->maketext( $format, @args ) if $enc =~ m/utf-?8/i;
1752        $format = MT::I18N::encode_text( $format, $enc, 'utf-8' );
1753        MT::I18N::encode_text(
1754            $LH->maketext(
1755                $format,
1756                map { MT::I18N::encode_text( $_, $enc, 'utf-8' ) } @args
1757            ),
1758            'utf-8', $enc
1759        );
1760    }
1761
1762    sub translate_templatized {
1763        my $mt = shift;
1764        my $app = ref($mt) ? $mt : $mt->app;
1765        if ( $app->{component} ) {
1766            if ( my $c = $app->component( $app->{component} ) ) {
1767                local $app->{component} = undef;
1768                return $c->translate_templatized(@_);
1769            }
1770        }
1771        my @cstack;
1772        my ($text) = @_;
1773        while (1) {
1774            $text =~ s!(<(/)?(?:_|MT)_TRANS(_SECTION)?(?:(?:\s+((?:\w+)\s*=\s*(["'])(?:(<(?:[^"'>]|"[^"]*"|'[^']*')+)?>|[^\5]+?)*?\5))+?\s*/?)?>)!
1775            my($msg, $close, $section, %args) = ($1, $2, $3);
1776            while ($msg =~ /\b(\w+)\s*=\s*(["'])((?:<(?:[^"'>]|"[^"]*"|'[^']*')+?>|[^\2])*?)?\2/g) {  #"
1777                $args{$1} = $3;
1778            }
1779            if ($section) {
1780                if ($close) {
1781                    $mt = pop @cstack;
1782                } else {
1783                    if ($args{component}) {
1784                        push @cstack, $mt;
1785                        $mt = MT->component($args{component})
1786                            or die "Bad translation component: $args{component}";
1787                    }
1788                    else {
1789                        die "__trans_section without a component argument";
1790                    }
1791                }
1792                '';
1793            }
1794            else {
1795                $args{params} = '' unless defined $args{params};
1796                my @p = map MT::Util::decode_html($_),
1797                        split /\s*%%\s*/, $args{params}, -1;
1798                @p = ('') unless @p;
1799                my $translation = $mt->translate($args{phrase}, @p);
1800                if (exists $args{escape}) {
1801                    if (lc($args{escape}) eq 'html') {
1802                        $translation = MT::Util::encode_html($translation);
1803                    } elsif (lc($args{escape}) eq 'url') {
1804                        $translation = MT::Util::encode_url($translation);
1805                    } else {
1806                        # fallback for js/javascript/singlequotes
1807                        $translation = MT::Util::encode_js($translation);
1808                    }
1809                }
1810                $translation;
1811            }
1812            !igem or last;
1813        }
1814        return $text;
1815    }
1816
1817    sub current_language { $LH->language_tag }
1818    sub language_handle  { $LH }
1819
1820    sub charset {
1821        my $mt = shift;
1822        $mt->{charset} = shift if @_;
1823        return $mt->{charset} if $mt->{charset};
1824        $mt->{charset} = $mt->config->PublishCharset
1825          || $mt->language_handle->encoding;
1826    }
1827}
1828
1829sub supported_languages {
1830    my $mt = shift;
1831    require MT::L10N;
1832    require File::Basename;
1833    ## Determine full path to lib/MT/L10N directory...
1834    my $lib =
1835      File::Spec->catdir( File::Basename::dirname( $INC{'MT/L10N.pm'} ),
1836        'L10N' );
1837    ## ... From that, determine full path to extlib/MT/L10N.
1838    ## To do that, we look for the last instance of the string 'lib'
1839    ## in $lib and replace it with 'extlib'. reverse is a nice tricky
1840    ## way of doing that.
1841    ( my $extlib = reverse $lib ) =~ s!bil!biltxe!;
1842    $extlib = reverse $extlib;
1843    my @dirs = ( $lib, $extlib );
1844    my %langs;
1845    for my $dir (@dirs) {
1846        opendir DH, $dir or next;
1847        for my $f ( readdir DH ) {
1848            my ($tag) = $f =~ /^(\w+)\.pm$/;
1849            next unless $tag;
1850            my $lh = MT::L10N->get_handle($tag);
1851            $langs{ $lh->language_tag } = $lh->language_name;
1852        }
1853        closedir DH;
1854    }
1855    \%langs;
1856}
1857
1858# For your convenience
1859sub trans_error {
1860    my $app = shift;
1861    $app->error( $app->translate(@_) );
1862}
1863
1864sub all_text_filters {
1865    unless (%Text_filters) {
1866        if ( my $filters = MT->registry('text_filters') ) {
1867            %Text_filters = %$filters if ref($filters) eq 'HASH';
1868        }
1869    }
1870    if (my $enabled_filters = MT->config('AllowedTextFilters')) {
1871        my %enabled = map { $_ => 1 } split /\s*,\s*/, $enabled_filters;
1872        %Text_filters = map { $_ => $Text_filters{$_} }
1873                        grep { exists $enabled{$_} }
1874                        keys %Text_filters;
1875    }
1876    return \%Text_filters;
1877}
1878
1879sub apply_text_filters {
1880    my $mt = shift;
1881    my ( $str, $filters, @extra ) = @_;
1882    my $all_filters = $mt->all_text_filters;
1883    for my $filter (@$filters) {
1884        my $f = $all_filters->{$filter} or next;
1885        my $code = $f->{code} || $f->{handler};
1886        unless ( ref($code) eq 'CODE' ) {
1887            $code = $mt->handler_to_coderef($code);
1888            $f->{code} = $code;
1889        }
1890        if ( !$code ) {
1891            warn "Bad text filter: $filter";
1892            next;
1893        }
1894        $str = $code->( $str, @extra );
1895    }
1896    return $str;
1897}
1898
1899sub static_path {
1900    my $app = shift;
1901    my $spath = $app->config->StaticWebPath;
1902    if (!$spath) {
1903        $spath = $app->config->CGIPath;
1904        $spath .= '/' unless $spath =~ m!/$!;
1905        $spath .= 'mt-static/';
1906    } else {
1907        $spath .= '/' unless $spath =~ m!/$!;
1908    }
1909    $spath;
1910}
1911
1912sub static_file_path {
1913    my $app = shift;
1914    return $app->{__static_file_path}
1915        if exists $app->{__static_file_path};
1916
1917    my $path = $app->config('StaticFilePath');
1918    return $app->{__static_file_path} = $path if defined $path;
1919
1920    # Attempt to derive StaticFilePath based on environment
1921    my $web_path = $app->config->StaticWebPath || 'mt-static';
1922    $web_path =~ s!^https?://[^/]+/!!;
1923    if ($app->can('document_root')) {
1924        my $doc_static_path = File::Spec->catdir($app->document_root(), $web_path);
1925        return $app->{__static_file_path} = $doc_static_path
1926            if -d $doc_static_path;
1927    }
1928    my $mtdir_static_path = File::Spec->catdir($app->mt_dir, 'mt-static');
1929    return $app->{__static_file_path} = $mtdir_static_path
1930        if -d $mtdir_static_path;
1931    return;
1932}
1933
1934sub template_paths {
1935    my $mt = shift;
1936    my @paths;
1937    my $path = $mt->config->TemplatePath;
1938    if ($mt->{plugin_template_path}) {
1939        if (File::Spec->file_name_is_absolute($mt->{plugin_template_path})) {
1940            push @paths, $mt->{plugin_template_path}
1941                if -d $mt->{plugin_template_path};
1942        } else {
1943            my $dir = File::Spec->catdir($mt->app_dir,
1944                                         $mt->{plugin_template_path});
1945            if (-d $dir) {
1946                push @paths, $dir;
1947            } else {
1948                $dir = File::Spec->catdir($mt->mt_dir,
1949                                          $mt->{plugin_template_path});
1950                push @paths, $dir if -d $dir;
1951            }
1952        }
1953    }
1954    if (my $alt_path = $mt->config->AltTemplatePath) {
1955        if (-d $alt_path) {    # AltTemplatePath is absolute
1956            push @paths, File::Spec->catdir($alt_path,
1957                                            $mt->{template_dir})
1958                if $mt->{template_dir};
1959            push @paths, $alt_path;
1960        }
1961    }
1962 
1963    for my $addon ( @{ $mt->find_addons('pack') } ) {
1964        push @paths, File::Spec->catdir($addon->{path}, 'tmpl', $mt->{template_dir})
1965            if $mt->{template_dir};
1966        push @paths, File::Spec->catdir($addon->{path}, 'tmpl');
1967    }
1968
1969    push @paths, File::Spec->catdir($path, $mt->{template_dir})
1970        if $mt->{template_dir};
1971    push @paths, $path;
1972 
1973    return @paths;
1974}
1975
1976sub find_file {
1977    my $mt = shift;
1978    my ($paths, $file) = @_;
1979    my $filename;
1980    foreach my $p (@$paths) {
1981        my $filepath = File::Spec->canonpath(File::Spec->catfile($p, $file));
1982        $filename = File::Spec->canonpath($filepath);
1983        return $filename if -f $filename;
1984    }
1985    undef;
1986}
1987
1988sub load_tmpl {
1989    my $mt = shift;
1990    if ($mt->{component}) {
1991        if (my $c = $mt->component($mt->{component})) {
1992            return $c->load_tmpl(@_);
1993        }
1994    }
1995
1996    my($file, @p) = @_;
1997    my $param;
1998    if (@p && (ref($p[$#p]) eq 'HASH')) {
1999        $param = pop @p;
2000    }
2001    my $cfg = $mt->config;
2002    require MT::Template;
2003    my $tmpl;
2004    my @paths = $mt->template_paths;
2005
2006    my $type = {'SCALAR' => 'scalarref', 'ARRAY' => 'arrayref'}->{ref $file}
2007        || 'filename';
2008    $tmpl = MT::Template->new(
2009        type => $type, source => $file,
2010        path => \@paths,
2011        filter => sub {
2012            my ($str, $fname) = @_;
2013            if ($fname) {
2014                $fname = File::Basename::basename($fname);
2015                $fname =~ s/\.tmpl$//;
2016                $mt->run_callbacks("template_source.$fname", $mt, @_);
2017            } else {
2018                $mt->run_callbacks("template_source", $mt, @_);
2019            }
2020            return $str;
2021        },
2022        @p);
2023    return $mt->error(
2024        $mt->translate("Loading template '[_1]' failed.", $file)) unless $tmpl;
2025    $mt->set_default_tmpl_params($tmpl);
2026    $tmpl->param($param) if $param;
2027    $tmpl;
2028}
2029
2030sub set_default_tmpl_params {
2031    my $mt = shift;
2032    my ($tmpl) = @_;
2033    my $param = {};
2034    $param->{mt_debug} = $MT::DebugMode;
2035    $param->{mt_beta} = 1 if MT->version_id =~ m/^\d+\.\d+(?:a|b|rc)/;
2036    $param->{static_uri} = $mt->static_path;
2037    $param->{mt_version} = MT->version_number;
2038    $param->{mt_version_id} = MT->version_id;
2039    $param->{mt_product_code} = MT->product_code;
2040    $param->{mt_product_name} = $mt->translate(MT->product_name);
2041    $param->{language_tag} = substr($mt->current_language, 0, 2);
2042    $param->{language_encoding} = $mt->charset;
2043    if ($mt->isa('MT::App')) {
2044        if (my $author = $mt->user) {
2045            $param->{author_id} = $author->id;
2046            $param->{author_name} = $author->name;
2047        }
2048        ## We do this in load_tmpl because show_error and login don't call
2049        ## build_page; so we need to set these variables here.
2050        require MT::Auth;
2051        $param->{can_logout} = MT::Auth->can_logout;
2052        $param->{script_url} = $mt->uri;
2053        $param->{mt_url} = $mt->mt_uri;
2054        $param->{script_path} = $mt->path;
2055        $param->{script_full_url} = $mt->base . $mt->uri;
2056        $param->{agent_mozilla} = ( $ENV{HTTP_USER_AGENT} || '' ) =~ /gecko/i;
2057        $param->{agent_ie} = ( $ENV{HTTP_USER_AGENT} || '' ) =~ /\bMSIE\b/;
2058    }
2059    if (!$tmpl->param('template_filename')) {
2060        if (my $fname = $tmpl->{__file}) {
2061            $fname =~ s!\\!/!g;
2062            $fname =~ s/\.tmpl$//;
2063            $param->{template_filename} = $fname;
2064        }
2065    }
2066    $tmpl->param($param);
2067}
2068
2069sub process_mt_template {
2070    my $mt = shift;
2071    my ($body) = @_;
2072    $body =~ s@<(?:_|MT)_ACTION\s+mode="([^"]+)"(?:\s+([^>]*))?>@
2073        my $mode = $1; my %args;
2074        %args = $2 =~ m/\s*(\w+)="([^"]*?)"\s*/g if defined $2; # "
2075        MT::Util::encode_html($mt->uri(mode => $mode, args => \%args));
2076    @geis;
2077    # Strip out placeholder wrappers to facilitate tmpl_* callbacks
2078    $body =~ s/<\/?MT_(\w+):(\w+)>//g;
2079    $body;
2080}
2081
2082sub build_page {
2083    my $mt = shift;
2084    my($file, $param) = @_;
2085    my $tmpl;
2086    my $mode = $mt->mode;
2087    $param->{"mode_$mode"} ||= 1;
2088    $param->{breadcrumbs} = $mt->{breadcrumbs};
2089    if ($param->{breadcrumbs}[-1]) {
2090        $param->{breadcrumbs}[-1]{is_last} = 1;
2091        $param->{page_titles} = [ reverse @{ $mt->{breadcrumbs} } ];
2092    }
2093    pop @{ $param->{page_titles} };
2094    if (my $lang_id = $mt->current_language) {
2095        $param->{local_lang_id} ||= lc $lang_id;
2096    }
2097    $param->{magic_token} = $mt->current_magic if $mt->user;
2098
2099    # List of installed packs in the application footer
2100    my @packs_installed;
2101    my $packs = $mt->find_addons('pack');
2102    if ($packs) {
2103        foreach my $pack (@$packs) {
2104            my $c = $mt->component(lc $pack->{id});
2105            if ($c) {
2106                my $label = $c->label || $pack->{label};
2107                $label = $label->() if ref($label) eq 'CODE';
2108                push @packs_installed, {
2109                    label => $label,
2110                    version => $c->version,
2111                    id => $c->id,
2112                };
2113            }
2114        }
2115    }
2116    @packs_installed = sort { $a->{label} cmp $b->{label} } @packs_installed;
2117    $param->{packs_installed} = \@packs_installed;
2118    $param->{portal_url} = $mt->translate("__PORTAL_URL__");
2119
2120    for my $config_field (keys %{ MT::ConfigMgr->instance->{__var} || {} }) {
2121        $param->{ $config_field . '_readonly' } = 1;
2122    }
2123
2124    my $tmpl_file = '';
2125    if (UNIVERSAL::isa($file, 'MT::Template')) {
2126        $tmpl = $file;
2127        $tmpl_file = (exists $file->{__file}) ? $file->{__file} : '';
2128    } else {
2129        $tmpl = $mt->load_tmpl($file) or return;
2130    }
2131
2132    if (($mode && ($mode !~ m/delete/)) && ($mt->{login_again} ||
2133        ($mt->{requires_login} && !$mt->user))) {
2134        ## If it's a login screen, direct the user to where they were going
2135        ## (query params including mode and all) unless they were logging in,
2136        ## logging out, or deleting something.
2137        my $q = $mt->{query};
2138        if ($mode) {
2139            my @query = map { {name => $_, value => scalar $q->param($_)}; }
2140                grep { ($_ ne 'username') && ($_ ne 'password') && ($_ ne 'submit') && ($mode eq 'logout' ? ($_ ne '__mode') : 1) } $q->param;
2141            $param->{query_params} = \@query;
2142        }
2143        $param->{login_again} = $mt->{login_again};
2144    }
2145
2146    my $blog = $mt->blog;
2147    $tmpl->context()->stash('blog', $blog) if $blog;
2148
2149    $tmpl->param($param) if $param;
2150
2151    if ($tmpl_file) {
2152        $tmpl_file = File::Basename::basename($tmpl_file);
2153        $tmpl_file =~ s/\.tmpl$//;
2154        $tmpl_file = '.' . $tmpl_file;
2155    }
2156    $mt->run_callbacks('template_param' . $tmpl_file, $mt, $tmpl->param, $tmpl);
2157
2158    my $output = $mt->build_page_in_mem($tmpl);
2159    return unless defined $output;
2160
2161    $mt->run_callbacks('template_output' . $tmpl_file, $mt, \$output, $tmpl->param, $tmpl);
2162    return $output;
2163}
2164
2165sub build_page_in_mem {
2166    my $mt = shift;
2167    my($tmpl, $param) = @_;
2168    $tmpl->param($param) if $param;
2169    my $out = $tmpl->output;
2170    return $mt->error($tmpl->errstr) unless defined $out;
2171    return $mt->translate_templatized($mt->process_mt_template($out));
2172}
2173
2174sub new_ua {
2175    my $class = shift;
2176    my ($opt) = @_;
2177    $opt ||= {};
2178    my $lwp_class = 'LWP::UserAgent';
2179    if ($opt->{paranoid}) {
2180        eval { require LWPx::ParanoidAgent; };
2181        $lwp_class = 'LWPx::ParanoidAgent' unless $@;
2182    }
2183    eval "require $lwp_class;";
2184    return undef if $@;
2185    my $cfg = $class->config;
2186    my $max_size = exists $opt->{max_size} ? $opt->{max_size} : 100_000;
2187    my $timeout = exists $opt->{timeout} ? $opt->{timeout} : $cfg->HTTPTimeout || $cfg->PingTimeout;
2188    my $proxy = exists $opt->{proxy} ? $opt->{proxy} : $cfg->HTTPProxy || $cfg->PingProxy;
2189    my $no_proxy = exists $opt->{no_proxy} ? $opt->{no_proxy} : $cfg->HTTPNoProxy || $cfg->PingNoProxy;
2190    my $agent = $opt->{agent} || 'MovableType/' . $MT::VERSION;
2191    my $interface = exists $opt->{interface} ? $opt->{interface} : $cfg->HTTPInterface || $cfg->PingInterface;
2192
2193    if ( my $localaddr = $interface ) {
2194        @LWP::Protocol::http::EXTRA_SOCK_OPTS = (
2195            LocalAddr => $localaddr,
2196            Reuse     => 1
2197        );
2198    }
2199
2200    my $ua = $lwp_class->new;
2201    $ua->max_size($max_size) if (defined $max_size) && $ua->can('max_size');
2202    $ua->agent( $agent );
2203    $ua->timeout( $timeout ) if defined $timeout;
2204    if ( defined $proxy ) {
2205        $ua->proxy( http => $proxy );
2206        my @domains = split( /,\s*/, $no_proxy ) if $no_proxy;
2207        $ua->no_proxy(@domains) if @domains;
2208    }
2209    return $ua;
2210}
2211
2212sub build_email {
2213    my $class = shift;
2214    my ( $file, $param ) = @_;
2215    my $mt = $class->instance;
2216
2217    # basically, try to load from database
2218    my $blog = $param->{blog} || undef;
2219    my $id = $file;
2220    $id =~ s/(\.tmpl|\.mtml)$//;
2221
2222    require MT::Template;
2223    my @tmpl = MT::Template->load(
2224        {
2225            ( $blog ? ( blog_id => [ $blog->id, 0 ] ) : ( blog_id => 0 ) ),
2226            identifier => $id,
2227            type       => 'email',
2228        }
2229    );
2230    my $tmpl =
2231      @tmpl
2232      ? (
2233        scalar @tmpl > 1
2234        ? ( $tmpl[0]->blog_id ? $tmpl[0] : $tmpl[1] )
2235        : $tmpl[0]
2236      )
2237      : undef;
2238
2239    # try to load from file
2240    unless ($tmpl) {
2241        local $mt->{template_dir} = 'email';
2242        $tmpl = $mt->load_tmpl($file);
2243    }
2244    return unless $tmpl;
2245
2246    my $ctx = $tmpl->context;
2247    $ctx->stash( 'blog',   delete $param->{'blog'} )   if $param->{'blog'};
2248    $ctx->stash( 'entry',  delete $param->{'entry'} )  if $param->{'entry'};
2249    $ctx->stash( 'author', delete $param->{'author'} ) if $param->{'author'};
2250    $ctx->stash( 'commenter', delete $param->{'commenter'} )
2251      if $param->{'commenter'};
2252    $ctx->stash( 'comment', delete $param->{'comment'} ) if $param->{'comment'};
2253    $ctx->stash( 'category', delete $param->{'category'} )
2254      if $param->{'category'};
2255    $ctx->stash( 'ping', delete $param->{'ping'} ) if $param->{'ping'};
2256
2257    foreach my $p (%$param) {
2258        if ( ref($p) ) {
2259            $tmpl->param( $p, $param->{$p} );
2260        }
2261    }
2262    return $mt->build_page_in_mem( $tmpl, $param );
2263}
2264
2265sub get_next_sched_post_for_user {
2266    my ( $author_id, @further_blog_ids ) = @_;
2267    require MT::Permission;
2268    my @perms = MT::Permission->load( { author_id => $author_id }, {} );
2269    my @blogs = @further_blog_ids;
2270    for my $perm (@perms) {
2271        next
2272          unless ( $perm->can_edit_config
2273            || $perm->can_publish_post
2274            || $perm->can_edit_all_posts );
2275        push @blogs, $perm->blog_id;
2276    }
2277    my $next_sched_utc = undef;
2278    require MT::Entry;
2279    for my $blog_id (@blogs) {
2280        my $blog           = MT::Blog->load($blog_id);
2281        my $earliest_entry = MT::Entry->load(
2282            {
2283                status  => MT::Entry::FUTURE(),
2284                blog_id => $blog_id
2285            },
2286            { 'sort' => 'created_on' }
2287        );
2288        if ($earliest_entry) {
2289            my $entry_utc =
2290              MT::Util::ts2iso( $blog, $earliest_entry->created_on );
2291            if ( $entry_utc < $next_sched_utc || !defined($next_sched_utc) ) {
2292                $next_sched_utc = $entry_utc;
2293            }
2294        }
2295    }
2296    return $next_sched_utc;
2297}
2298
2299our %Commenter_Auth;
2300
2301sub init_commenter_authenticators {
2302    my $self = shift;
2303    my $auths = $self->registry("commenter_authenticators") || {};
2304    foreach my $auth ( keys %$auths ) {
2305        delete $auths->{$auth}
2306          if exists( $auths->{$auth}->{condition} )
2307          && !( $auths->{$auth}->{condition}->() );
2308    }
2309    %Commenter_Auth = %$auths;
2310    $Commenter_Auth{$_}{key} ||= $_ for keys %Commenter_Auth;
2311}
2312
2313sub commenter_authenticator {
2314    my $self = shift;
2315    my ($key) = @_;
2316    %Commenter_Auth or $self->init_commenter_authenticators();
2317    return $Commenter_Auth{$key};
2318}
2319
2320sub commenter_authenticators {
2321    my $self = shift;
2322    %Commenter_Auth or $self->init_commenter_authenticators();
2323    return values %Commenter_Auth;
2324}
2325
2326sub _commenter_auth_params {
2327    my ( $key, $blog_id, $entry_id, $static ) = @_;
2328    my $params = {
2329        blog_id => $blog_id,
2330        static  => $static,
2331    };
2332    $params->{entry_id} = $entry_id if defined $entry_id;
2333    return $params;
2334}
2335
2336sub _openid_commenter_condition {
2337    eval "require Digest::SHA1;";
2338    return $@ ? 0 : 1;
2339}
2340
2341sub core_commenter_authenticators {
2342    return {
2343        'OpenID' => {
2344            class      => 'MT::Auth::OpenID',
2345            label      => 'OpenID',
2346            login_form => <<OpenID,
2347<form method="post" action="<mt:var name="script_url">">
2348<input type="hidden" name="__mode" value="login_external" />
2349<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2350<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2351<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2352<fieldset>
2353<mtapp:setting
2354    id="openid_display"
2355    label="<__trans phrase="OpenID URL">"
2356    hint="<__trans phrase="Sign in using your OpenID identity.">">
2357<input type="hidden" name="key" value="OpenID" />
2358<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%;" />
2359    <p class="hint"><__trans phrase="OpenID is an open and decentralized single sign-on identity system."></p>
2360</mtapp:setting>
2361
2362<div class="pkg">
2363<div class="left"><input type="submit" name="submit" value="<__trans phrase="Sign In">" /></div>
2364<div class="right"><img src="<mt:var name="static_uri">images/comment/openid_enabled.png" /></div>
2365</div>
2366<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>
2367</fieldset>
2368</form>
2369OpenID
2370            login_form_params => \&_commenter_auth_params,
2371            condition         => \&_openid_commenter_condition,
2372            logo              => 'images/comment/signin_openid.png',
2373            logo_small        => 'images/comment/openid_logo.png',
2374        },
2375        'LiveJournal' => {
2376            class      => 'MT::Auth::LiveJournal',
2377            label      => 'LiveJournal',
2378            login_form => <<LiveJournal,
2379<form method="post" action="<mt:var name="script_url">">
2380<input type="hidden" name="__mode" value="login_external" />
2381<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2382<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2383<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2384<input type="hidden" name="key" value="LiveJournal" />
2385<fieldset>
2386<mtapp:setting
2387    id="livejournal_display"
2388    label="<__trans phrase="Your LiveJournal Username">"
2389    hint="<__trans phrase="Sign in using your Vox blog URL">">
2390<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%;" />
2391</mtapp:setting>
2392<div class="actions-bar actions-bar-login">
2393    <div class="actions-bar-inner pkg actions">
2394        <button
2395            type="submit"
2396            class="primary-button"
2397            ><__trans phrase="Sign in"></button>
2398    </div>
2399</div>
2400<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>
2401</fieldset>
2402</form>
2403LiveJournal
2404            login_form_params => \&_commenter_auth_params,
2405            condition         => \&_openid_commenter_condition,
2406            logo              => 'images/comment/signin_livejournal.png',
2407            logo_small        => 'images/comment/livejournal_logo.png',
2408        },
2409        'Vox' => {
2410            class      => 'MT::Auth::Vox',
2411            label      => 'Vox',
2412            login_form => <<Vox,
2413<form method="post" action="<mt:var name="script_url">">
2414<input type="hidden" name="__mode" value="login_external" />
2415<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2416<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2417<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2418<input type="hidden" name="key" value="Vox" />
2419<fieldset>
2420<mtapp:setting
2421    id="vox_display"
2422    label="<__trans phrase="Your Vox Blog URL">">
2423http:// <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
2424</mtapp:setting>
2425<div class="actions-bar actions-bar-login">
2426    <div class="actions-bar-inner pkg actions">
2427        <button
2428            type="submit"
2429            class="primary-button"
2430            ><__trans phrase="Sign in"></button>
2431    </div>
2432</div>
2433<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>
2434</fieldset>
2435</form>
2436Vox
2437            login_form_params => \&_commenter_auth_params,
2438            condition         => \&_openid_commenter_condition,
2439            logo              => 'images/comment/signin_vox.png',
2440            logo_small        => 'images/comment/vox_logo.png',
2441        },
2442        'TypeKey' => {
2443            class      => 'MT::Auth::TypeKey',
2444            label      => 'TypeKey',
2445            login_form => <<TypeKey,
2446<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>
2447<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>
2448TypeKey
2449            login_form_params => sub {
2450                my ( $key, $blog_id, $entry_id, $static ) = @_;
2451                my $entry = MT::Entry->load($entry_id) if $entry_id;
2452
2453                ## TypeKey URL
2454                require MT::Template::Context;
2455                my $ctx = MT::Template::Context->new;
2456                $ctx->stash( 'blog_id', $blog_id );
2457                my $blog = MT::Blog->load($blog_id);
2458                $ctx->stash( 'blog',  $blog );
2459                $ctx->stash( 'entry', $entry );
2460                my $params = {};
2461                $params->{tk_signin_url} =
2462                  MT::Template::Context::_hdlr_remote_sign_in_link( $ctx,
2463                    { static => $static } );
2464                return $params;
2465            },
2466            logo => 'images/comment/signin_typekey.png',
2467            logo_small        => 'images/comment/typekey_logo.png',
2468        },
2469    };
2470}
2471
2472our %Captcha_Providers;
2473
2474sub captcha_provider {
2475    my $self = shift;
2476    my ($key) = @_;
2477    $self->init_captcha_providers() unless %Captcha_Providers;
2478    return $Captcha_Providers{$key};
2479}
2480
2481sub captcha_providers {
2482    my $self = shift;
2483    $self->init_captcha_providers() unless %Captcha_Providers;
2484    my $def  = delete $Captcha_Providers{'mt_default'};
2485    my @vals = values %Captcha_Providers;
2486    if ( defined($def) && $def->{condition}->() ) {
2487        unshift @vals, $def;
2488    }
2489    @vals;
2490}
2491
2492sub core_captcha_providers {
2493    return {
2494        'mt_default' => {
2495            label     => 'Movable Type default',
2496            class     => 'MT::Util::Captcha',
2497            condition => sub {
2498                require MT::Util::Captcha;
2499                if ( my $error = MT::Util::Captcha->check_availability ) {
2500                    return 0;
2501                }
2502                1;
2503            },
2504        }
2505    };
2506}
2507
2508sub init_captcha_providers {
2509    my $self = shift;
2510    my $providers = $self->registry("captcha_providers") || {};
2511    foreach my $provider ( keys %$providers ) {
2512        delete $providers->{$provider}
2513          if exists( $providers->{$provider}->{condition} )
2514          && !( $providers->{$provider}->{condition}->() );
2515    }
2516    %Captcha_Providers = %$providers;
2517    $Captcha_Providers{$_}{key} ||= $_ for keys %Captcha_Providers;
2518}
2519
2520sub effective_captcha_provider {
2521    my $class = shift;
2522    my ($key) = @_;
2523    return undef unless $key;
2524    my $cp = $class->captcha_provider($key) or return;
2525    if ( exists $cp->{condition} ) {
2526        return undef unless $cp->{condition}->();
2527    }
2528    my $pkg = $cp->{class};
2529    $pkg =~ s/;//g;
2530    eval "require $pkg" or return;
2531    return $cp->{class};
2532}
2533
2534sub handler_to_coderef {
2535    my $pkg = shift;
2536    my ( $name, $delayed ) = @_;
2537
2538    return $name if ref($name) eq 'CODE';
2539    return undef unless defined $name && $name ne '';
2540
2541    my $code;
2542    if ( $name !~ m/->/ ) {
2543
2544        # check for Package::Routine first; if defined, return coderef
2545        no strict 'refs';
2546        $code = \&$name if defined &$name;
2547        return $code if $code;
2548    }
2549
2550    my $component;
2551    if ( $name =~ m!^\$! ) {
2552        if ( $name =~ s/^\$(\w+)::// ) {
2553            $component = $1;
2554        }
2555    }
2556    if ( $name =~ m/^\s*sub\s*\{/s ) {
2557        $code = eval $name or die $@;
2558
2559        if ($component) {
2560            return sub {
2561                my $mt_inst = MT->instance;
2562                local $mt_inst->{component} = $component;
2563                $code->(@_);
2564            };
2565        }
2566        else {
2567            return $code;
2568        }
2569    }
2570
2571    my $hdlr_pkg = $name;
2572    my $method;
2573    if ( $hdlr_pkg =~ s/(->|::)([^:]+)$// ) {    # strip routine name
2574        $method = $2 if $1 eq '->';
2575    }
2576    if ( !defined(&$name) && !$pkg->can( 'AUTOLOAD' ) ) {
2577
2578        # The delayed option will return a coderef that delays the loading
2579        # of the package holding the handler routine.
2580        if ($delayed) {
2581            if ($method) {
2582                return sub {
2583                    eval "require $hdlr_pkg;"
2584                      or Carp::confess(
2585                        "failed loading package $hdlr_pkg for routine $name: $@");
2586                    my $mt_inst = MT->instance;
2587                    local $mt_inst->{component} = $component
2588                      if $component;
2589                    return $hdlr_pkg->$method(@_);
2590                };
2591            }
2592            else {
2593                return sub {
2594                    eval "require $hdlr_pkg;"
2595                      or Carp::confess(
2596                        "failed loading package $hdlr_pkg for routine $name: $@");
2597                    my $mt_inst = MT->instance;
2598                    local $mt_inst->{component} = $component
2599                      if $component;
2600                    no strict 'refs';
2601                    my $hdlr = \&$name;
2602                    use strict 'refs';
2603                    return $hdlr->(@_);
2604                };
2605            }
2606        }
2607        else {
2608            eval "require $hdlr_pkg;"
2609              or Carp::confess(
2610                "failed loading package $hdlr_pkg for routine $name: $@");
2611        }
2612    }
2613    if ($method) {
2614        $code = sub {
2615            my $mt_inst = MT->instance;
2616            local $mt_inst->{component} = $component
2617              if $component;
2618            return $hdlr_pkg->$method(@_);
2619        };
2620    }
2621    else {
2622        if ($component) {
2623            $code = sub {
2624                no strict 'refs';
2625                my $hdlr = (
2626                    defined &$name ? \&$name
2627                    : ( $pkg->can( 'AUTOLOAD' ) ? \&$name
2628                        : undef )
2629                );
2630                use strict 'refs';
2631                if ($hdlr) {
2632                    my $mt_inst = MT->instance;
2633                    local $mt_inst->{component} = $component
2634                      if $component;
2635                    return $hdlr->(@_);
2636                }
2637                return undef;
2638              }
2639        }
2640        else {
2641            no strict 'refs';
2642            $code =
2643              (
2644                defined &$name
2645                ? \&$name
2646                : ( $hdlr_pkg->can( 'AUTOLOAD' ) ? \&$name : undef )
2647              );
2648        }
2649    }
2650    return $code;
2651}
2652
2653sub help_url {
2654    my $pkg = shift;
2655    my ( $append ) = @_;
2656
2657    my $url = $pkg->config->HelpURL;
2658    return $url if defined $url;
2659    $url = $pkg->translate('http://www.movabletype.org/documentation/');
2660    if ( $append ) {
2661        $url .= $append;
2662    }
2663    $url;
2664}
2665
2666sub register_refresh_cache_event {
2667    my $pkg = shift;
2668    my ($callback) = @_;
2669    return unless $callback;
2670
2671    MT->_register_core_callbacks({
2672        "$callback" => \&refresh_cache,
2673    });
2674}
2675
2676sub refresh_cache {
2677    my ($cb, %args) = @_;
2678
2679    require MT::Cache::Negotiate;
2680    my $cache_driver = MT::Cache::Negotiate->new();
2681    return unless $cache_driver;
2682
2683    $cache_driver->flush_all();
2684}
2685
2686sub DESTROY {
2687    # save_config here so not to miss any dirty config change to persist
2688    # particulary for those which does not construct MT::App.
2689    $_[0]->config->save_config();
2690}
2691
26921;
2693
2694__END__
2695
2696=head1 NAME
2697
2698MT - Movable Type
2699
2700=head1 SYNOPSIS
2701
2702    use MT;
2703    my $mt = MT->new;
2704    $mt->rebuild(BlogID => 1)
2705        or die $mt->errstr;
2706
2707=head1 DESCRIPTION
2708
2709The I<MT> class is the main high-level rebuilding/pinging interface in the
2710Movable Type library. It handles all rebuilding operations. It does B<not>
2711handle any of the application functionality--for that, look to I<MT::App> and
2712I<MT::App::CMS>, both of which subclass I<MT> to handle application requests.
2713
2714=head1 PLUGIN APPLICATIONS
2715
2716At any given time, the user of the Movable Type platform is
2717interacting with either the core Movable Type application, or a plugin
2718application (or "sub-application").
2719
2720A plugin application is a plugin with a user interface that inherits
2721functionality from Movable Type, and appears to the user as a
2722component of Movable Type. A plugin application typically has its own
2723templates displaying its own special features; but it inherits some
2724templates from Movable Type, such as the navigation chrome and error
2725pages.
2726
2727=head2 The MT Root and the Application Root
2728
2729To locate assets of the core Movable Type application and any plugin
2730applications, the platform uses two directory paths, C<mt_dir> and
2731C<app_dir>. These paths are returned by the MT class methods with the
2732same names, and some other methods return derivatives of these paths.
2733
2734Conceptually, mt_dir is the root of the Movable Type installation, and
2735app_dir is the root of the "currently running application", which
2736might be Movable Type or a plugin application. It is important to
2737understand the distinction between these two values and what each is
2738used for.
2739
2740The I<mt_dir> is the absolute path to the directory where MT itself is
2741located. Most importantly, the MT configuration file and the CGI scripts that
2742bootstrap an MT request are found here. This directory is also the
2743default base path under which MT's core templates are found (but this
2744can be overridden using the I<TemplatePath> configuration setting).
2745
2746Likewise, the I<app_dir> is the directory where the "current"
2747application's assets are rooted. The platform will search for
2748application templates underneath the I<app_dir>, but this search also
2749searches underneath the I<mt_dir>, allowing the application to make
2750use of core headers, footers, error pages, and possibly other
2751templates.
2752
2753In order for this to be useful, the plugin's templates and
2754code should all be located underneath the same directory. The relative
2755path from the I<app_dir> to the application's templates is
2756configurable. For details on how to indicate the location of your
2757plugin's templates, see L<MT::App>.
2758
2759=head2 Finding the Root Paths
2760
2761When a plugin application initializes its own application class (a
2762subclass of MT::App), the I<mt_dir> should be discovered and passed
2763constructor. This comes either from the C<Directory> parameter or the
2764C<Config> parameter.
2765
2766Since plugins are loaded from a descendent of the MT root directory,
2767the plugin bootstrap code can discover the MT configuration file (and thus
2768the MT root directory) by traversing the filesystem; the absolute path
2769to that file can be passed as the C<Config> parameter to
2770MT::App::new. Working code to do this can be found in the
2771examples/plugins/mirror/mt-mirror.cgi file.
2772
2773The I<app_dir>, on the other hand, always derives from the location of
2774the currently-running program, so it typically does not need to be
2775specified.
2776
2777=head1 USAGE
2778
2779I<MT> has the following interface. On failure, all methods return C<undef>
2780and set the I<errstr> for the object or class (depending on whether the
2781method is an object or class method, respectively); look below at the section
2782L<ERROR HANDLING> for more information.
2783
2784=head2 MT->new( %args )
2785
2786Constructs a new I<MT> instance and returns that object. Returns C<undef>
2787on failure.
2788
2789I<new> will also read your MT configuration file (provided that it can find it--if
2790you find that it can't, take a look at the I<Config> directive, below). It
2791will also initialize the chosen object driver; the default is the C<DBM>
2792object driver.
2793
2794I<%args> can contain:
2795
2796=over 4
2797
2798=item * Config
2799
2800Path to the MT configuration file.
2801
2802If you do not specify a path, I<MT> will try to find your MT configuration file
2803in the current working directory.
2804
2805=item * Directory
2806
2807Path to the MT home directory.
2808
2809If you do not specify a path, I<MT> will try to find the MT directory using
2810the discovered path of the MT configuration file.
2811
2812=back
2813
2814=head2 $mt->init
2815
2816Initializes the Movable Type instance, including registration of basic
2817resources and callbacks. This method also invokes the C<init_config>
2818and C<init_plugins> methods.
2819
2820=head2 MT->instance
2821
2822MT and all it's subclasses are now singleton classes, meaning you can only
2823have one instance per package. MT->instance() returns the active instance.
2824MT->new() is now an alias to instance_of.
2825
2826=head2 $class->instance_of
2827
2828Returns the singleton instance of the MT subclass identified by C<$class>.
2829
2830=head2 $class->construct
2831
2832Constructs a new instance of the MT subclass identified by C<$class>.
2833
2834=head2 MT->set_instance
2835
2836Assigns the active MT instance object. This value is returned when
2837C<MT-E<gt>instance> is invoked.
2838
2839=head2 $mt->find_config($params)
2840
2841Handles the discovery of the MT configuration file. The path and filename
2842for the configuration file is returned as the result. The C<$params>
2843parameter is a reference to the hash of settings passed to the MT
2844constructor.
2845
2846=head2 $mt->init_config($params)
2847
2848Reads the MT configuration settingss from the MT configuration file
2849and settings from database (L<MT::Config>).
2850
2851The C<$params> parameter is a reference to the hash of settings passed to
2852the MT constructor.
2853
2854=head2 $mt->init_plugins
2855
2856Loads any discoverable plugins that are available. This is called from
2857the C<init> method, after the C<init_config> method has loaded the
2858configuration settings.
2859
2860=head2 $mt->init_tasks
2861
2862Registers the standard set of periodic tasks that Movable Type provides
2863and then invokes the C<init_tasks> method for each available plugin.
2864
2865=head2 MT->run_tasks
2866
2867Initializes the tasks, running C<init_tasks> and invokes the task system
2868through L<MT::TaskMgr> to run any registered tasks that are pending
2869execution. See L<MT::TaskMgr> for further documentation.
2870
2871=head2 MT->unplug
2872
2873Removes the global reference to the MT instance.
2874
2875=head2 MT::log( $message ) or $mt->log( $message )
2876
2877Adds an entry to the application's log table. Also writes message to
2878STDERR which is typically routed to the web server's error log.
2879
2880=head2 $mt->server_path, $mt->mt_dir
2881
2882Both of these methods return the physical file path to the directory
2883that is the home of the MT installation. This would be the value of
2884the 'Directory' parameter given in the MT constructor, or would be
2885determined based on the path of the configuration file.
2886
2887=head2 $mt->app_dir
2888
2889Returns the physical file path to the active application directory. This
2890is determined by the directory of the active script.
2891
2892=head2 $mt->config_dir
2893
2894Returns the path to the MT configuration file.
2895
2896=head2 $mt->config([$setting[, $value]])
2897
2898This method is used to get and set configuration settings. When called
2899without any parameters, it returns the active MT::ConfigMgr instance
2900used by the application.
2901
2902Specifying the C<$setting> parameter will return the value for that setting.
2903When passing the C<$value> parameter, this will update the config object,
2904assigning that value for the named C<$setting>.
2905
2906=head2 $mt->user_class
2907
2908Returns the package name for the class used for user authentication.
2909This is typically L<MT::Author>.
2910
2911=head2 $mt->request([$element[,$data]])
2912
2913The request method provides a request-scoped storage object. It is an
2914access interface for the L<MT::Request> package. Calling without any
2915parameters will return the L<MT::Request> instance.
2916
2917When called with the C<$element> parameter, the data stored for that
2918element is returned (or undef, if it didn't exist). When called with
2919the C<$data> parameter, it will store the data into the specified
2920element in the request object.
2921
2922All values placed in the request object are lost at the end of the
2923request. If the running application is not a web-based application,
2924the request object exists for the lifetime of the process and is
2925released when the process ends.
2926
2927See the L<MT::Request> package for more information.
2928
2929=head2 MT->new_ua
2930
2931Returns a new L<LWP::UserAgent> instance that is configured according to the
2932Movable Type configuration settings (specifically C<HTTPInterface>, C<HTTPTimeout>, C<HTTPProxy> and C<HTTPNoProxy>). The agent string is set
2933to "MovableType/(version)" and is also limited to receiving a response of
2934100,000 bytes by default (you can override this by using the 'max_size'
2935method on the returned instance). Using this method is recommended for
2936any HTTP requests issued by Movable Type since it uses the MT configuration
2937settings to prepare the UserAgent object.
2938
2939=head2 $mt->ping( %args )
2940
2941Sends all configured XML-RPC pings as a way of notifying other community
2942sites that your blog has been updated.
2943
2944I<%args> can contain:
2945
2946=over 4
2947
2948=item * Blog
2949
2950An I<MT::Blog> object corresponding to the blog for which you would like to
2951send the pings.
2952
2953Either this or C<BlogID> is required.
2954
2955=item * BlogID
2956
2957The ID of the blog for which you would like to send the pings.
2958
2959Either this or C<Blog> is required.
2960
2961=back
2962
2963=head2 $mt->ping_and_save( %args )
2964
2965Handles the task of issuing any pending ping operations for a given
2966entry and then saving that entry back to the database.
2967
2968The I<%args> hash should contain an element named C<Entry> that is a
2969reference to a L<MT::Entry> object.
2970
2971=head2 $mt->needs_ping(%param)
2972
2973Returns a list of URLs that have not been pinged for a given entry. Named
2974parameters for this method are:
2975
2976=over 4
2977
2978=item Entry
2979
2980The L<MT::Entry> object to examine.
2981
2982=item Blog
2983
2984The L<MT::Blog> object that is the parent of the entry given.
2985
2986=back
2987
2988The return value is an array reference of URLs that have not been pinged
2989for the given entry.
2990
2991An empty list is returned for entries that have a non 'RELEASE' status.
2992
2993=head2 $mt->update_ping_list($blog)
2994
2995Returns a list of URLs for ping services that have been configured to
2996be notified when posting new entries.
2997
2998=head2 $mt->set_language($tag)
2999
3000Loads the localization plugin for the language specified by I<$tag>, which
3001should be a valid and supported language tag--see I<supported_languages> to
3002obtain a list of supported languages.
3003
3004The language is set on a global level, and affects error messages and all
3005text in the administration system.
3006
3007This method can be called as either a class method or an object method; in
3008other words,
3009
3010    MT->set_language($tag)
3011
3012will also work. However, the setting will still be global--it will not be
3013specified to the I<$mt> object.
3014
3015The default setting--set when I<MT::new> is called--is U.S. English. If a
3016I<DefaultLanguage> is set in the MT configuration file, the default is then
3017set to that language.
3018
3019=head2 MT->translate($str[, $param, ...])
3020
3021Translates I<$str> into the currently-set language (set by I<set_language>),
3022and returns the translated string. Any parameters following I<$str> are
3023passed through to the C<maketext> method of the active localization module.
3024
3025=head2 MT->translate_templatized($str)
3026
3027Translates a string that has embedded E<lt>MT_TRANSE<gt> tags. These
3028tags identify the portions of the string that require localization.
3029Each tag is processed separately and passed through the MT->translate
3030method. Examples (used in your application's HTML::Template templates):
3031
3032    <p><MT_TRANS phrase="Hello, world"></p>
3033
3034and
3035
3036    <p><MT_TRANS phrase="Hello, [_1]" params="<TMPL_VAR NAME=NAME>"></p>
3037
3038=head2 $mt->trans_error( $str[, $arg1, $arg2] )
3039
3040Translates I<$str> into the currently-set language (set by I<set_language>),
3041and assigns it as the active error for the MT instance. It returns undef,
3042which is the usual return value upon generating an error in the application.
3043So when an error occurs, the typical return result would be:
3044
3045    if ($@) {
3046        return $app->trans_error("An error occurred: [_1]", $@);
3047    }
3048
3049The optional I<$arg1> (and so forth) parameters are passed as parameters to
3050any parameterized error message.
3051
3052=head2 $mt->current_language
3053
3054Returns the language tag for the currently-set language.
3055
3056=head2 MT->supported_languages
3057
3058Returns a reference to an associative array mapping language tags to their
3059proper names. For example:
3060
3061    use MT;
3062    my $langs = MT->supported_languages;
3063    print map { $_ . " => " . $langs->{$_} . "\n" } keys %$langs;
3064
3065=head2 MT->language_handle
3066
3067Returns the active MT::L10N language instance for the active language.
3068
3069=head2 MT->add_plugin($plugin)
3070
3071Adds the plugin described by $plugin to the list of plugins displayed
3072on the welcome page. The argument should be an object of the
3073I<MT::Plugin> class.
3074
3075=head2 MT->all_text_filters
3076
3077Returns a reference to a hash containing the registry of text filters.
3078
3079=head2 MT->apply_text_filters($str, \@filters)
3080
3081Applies the set of filters I<\@filters> to the string I<$str> and returns
3082the result (the filtered string).
3083
3084I<\@filters> should be a reference to an array of filter keynames--these
3085are the short names passed in as the first argument to I<add_text_filter>.
3086I<$str> should be a scalar string to be filtered.
3087
3088If one of the filters listed in I<\@filters> is not found in the list of
3089registered filters (that is, filters added through I<add_text_filter>),
3090it will be skipped silently. Filters are executed in the order in which they
3091appear in I<\@filters>.
3092
3093As it turns out, the I<MT::Entry::text_filters> method returns a reference
3094to the list of text filters to be used for that entry. So, for example, to
3095use this method to apply filters to the main entry text for an entry
3096I<$entry>, you would use
3097
3098    my $out = MT->apply_text_filters($entry->text, $entry->text_filters);
3099
3100=head2 MT->add_callback($meth, $priority, $plugin, $code)
3101
3102Registers a new callback handler for a particular registered callback.
3103
3104The first parameter is the name of the callback method. The second
3105parameter is a priority (a number in the range of 1-10) which will control
3106the order that the handler is executed in relation to other handlers. If
3107two handlers register with the same priority, they will be executed in
3108the order that they registered. The third parameter is a C<MT::Plugin> object
3109reference that is associated with the handler (this parameter is optional).
3110The fourth parameter is a code reference that is invoked to handle the
3111callback. For example:
3112
3113    MT->add_callback('BuildFile', 1, undef, \&rebuild_file_hdlr);
3114
3115The code reference should expect to receive an object of type
3116L<MT::Callback> as its first argument. This object is used to
3117communicate errors to the caller:
3118
3119    sub rebuild_file_hdlr {
3120        my ($cb, ...) = @_;
3121        if (something bad happens) {
3122            return $cb->error("Something bad happened!");
3123        }
3124    }
3125
3126Other parameters to the callback function depend on the callback point.
3127
3128The treatment of the error string depends on the callback point.
3129Typically, either it is ignored or the user's action fails and the
3130error message is displayed.
3131
3132The value returned from this method is the new L<MT::Callback> object.
3133
3134=head2 MT->remove_callback($callback)
3135
3136Removes a callback that was previously registered.
3137
3138=head2 MT->register_callbacks([...])
3139
3140Registers several callbacks simultaneously. Each element in the array
3141parameter given should be a hashref containing these elements: C<name>,
3142C<priority>, C<plugin> and C<code>.
3143
3144=head2 MT->run_callbacks($meth[, $arg1, $arg2, ...])
3145
3146Invokes a particular callback, running any associated callback handlers.
3147
3148The first parameter is the name of the callback to execute. This is one
3149of the global callback methods (see L<Callbacks> section) or can be
3150a class-specific method that includes the package name associated with
3151the callback.
3152
3153The remaining arguments are passed through to any callback handlers that
3154are invoked.
3155
3156For "Filter"-type callbacks, this routine will return a 0 if any of the
3157handlers return a false result. If all handlers return a true result,
3158a value of 1 is returned.
3159
3160Example:
3161
3162    MT->run_callbacks('MyClass::frobnitzes', \@whirlygigs);
3163
3164Which would execute any handlers that registered in this fashion:
3165
3166    MT->add_callback('MyClass::frobnitzes', 4, $plugin, \&frobnitz_hdlr);
3167
3168=head2 MT->run_callback($cb[, $arg1, $arg2, ...])
3169
3170An internal routine used by C<run_callbacks> to invoke a single
3171L<MT::Callback>.
3172
3173=head2 callback_error($str)
3174
3175This routine is used internally by C<MT::Callback> to set any error response
3176that comes from invoking a callback.
3177
3178=head2 callback_errstr
3179
3180This internal routine returns the error response stored using the
3181C<callback_error> routine.
3182
3183=head2 MT->product_code
3184
3185The product code identifying the Movable Type product that is installed.
3186This is either 'MTE' for Movable Type Enterprise or 'MT' for the
3187non-Enterprise product.
3188
3189=head2 MT->product_name
3190
3191The name of the Movable Type product that is installed. This is either
3192'Movable Type Enterprise' or 'Movable Type Publishing Platform'.
3193
3194=head2 MT->product_version
3195
3196The version number of the product. This is different from the C<version_id>
3197and C<version_number> methods as they report the API version information.
3198
3199=head2 MT->version_id
3200
3201Returns the API version of MT (including any beta/alpha designations).
3202
3203=head2 MT->version_number
3204
3205Returns the numeric API version of MT (without any beta/alpha designations).
3206For example, if I<version_id> returned C<2.5b1>, I<version_number> would
3207return C<2.5>.
3208
3209=head2 MT->schema_version
3210
3211Returns the version of the MT database schema.
3212
3213=head2 MT->version_slug
3214
3215Returns a string of text that is appended to emails sent through the
3216C<build_email> method.
3217
3218=head2 $mt->publisher
3219
3220Returns the L<MT::WeblogPublisher> object that is used for managing the
3221MT publishing process. See L<MT::WeblogPublisher> for more information.
3222
3223=head2 $mt->rebuild
3224
3225An alias to L<MT::WeblogPublisher::rebuild>. See L<MT::WeblogPublisher>
3226for documentation of this method.
3227
3228=head2 $mt->rebuild_entry
3229
3230An alias to L<MT::WeblogPublisher::rebuild_entry>. See L<MT::WeblogPublisher>
3231for documentation of this method.
3232
3233=head2 $mt->rebuild_indexes
3234
3235An alias to L<MT::WeblogPublisher::rebuild_indexes>. See
3236L<MT::WeblogPublisher> for documentation of this method.
3237
3238=head2 $mt->build_email($file, $param)
3239
3240Loads a template from the application's 'email' template directory and
3241processes it as a HTML::Template. The C<$param> argument is a hash reference
3242of parameter data for the template. The return value is the output of the
3243template.
3244
3245=head2 MT::get_next_sched_post_for_user($author_id, @blog_ids)
3246
3247This is an internal routine used by L<MT::XMLRPCServer> and the
3248getNextScheduled XMLRPC method to determine the timestamp for the next
3249entry that is scheduled for publishing. The return value is the timestamp
3250in UTC time in the format "YYYY-MM-DDTHH:MM:SSZ".
3251
3252=head1 ERROR HANDLING
3253
3254On an error, all of the above methods return C<undef>, and the error message
3255can be obtained by calling the method I<errstr> on the class or the object
3256(depending on whether the method called was a class method or an instance
3257method).
3258
3259For example, called on a class name:
3260
3261    my $mt = MT->new or die MT->errstr;
3262
3263Or, called on an object:
3264
3265    $mt->rebuild(BlogID => $blog_id)
3266        or die $mt->errstr;
3267
3268=head1 DEBUGGING
3269
3270MT has a package variable C<$MT::DebugMode> which is assigned through
3271your MT configuration file (DebugMode setting). If this is set to
3272any non-zero value, MT applications will display any C<warn>'d
3273statements to a panel that is displayed within the app.
3274
3275The DebugMode is a bit-wise setting and offers the following options:
3276
3277    1 - Display debug messages
3278    2 - Display a stack trace for messages captured
3279    4 - Lists queries issued by Data::ObjectDriver
3280    8 - Reports on MT templates that take more than 1/4 second to build*
3281    128 - Outputs app-level request/response information to STDERR.
3282
3283These can be combined, so if you want to display queries and debug messages,
3284use a DebugMode of 5 for instance.
3285
3286You may also use the local statement to temporarily apply a particular bit,
3287if you want to scope the debug messages you receive to a block of code:
3288
3289    local $MT::DebugMode |= 4;  # show me the queries for the following
3290    my $obj = MT::Entry->load({....});
3291
3292*DebugMode bit 8 actually outputs it's messages to STDERR (which typically
3293is sent to your web server's error log).
3294
3295=head1 CALLBACKS
3296
3297Movable Type has a variety of hook points at which a plugin can attach
3298a callback.
3299
3300In each case, the first parameter is an L<MT::Callback> object which
3301can be used to pass error information back to the caller.
3302
3303The app-level callbacks related to rebuilding are documented
3304in L<MT::WeblogPublisher>. The specific apps document the callbacks
3305which they invoke.
3306
3307=head2 NewUserProvisioning($cb, $user)
3308
3309This callback is invoked when a user is being added to Movable Type.
3310Movable Type itself registers for this callback (with a priority of 5)
3311to provision the user with a new weblog if the system has been configured
3312to do so.
3313
3314=head1 LICENSE
3315
3316The license that applies is the one you agreed to when downloading
3317Movable Type.
3318
3319=head1 AUTHOR & COPYRIGHT
3320
3321Except where otherwise noted, MT is Copyright 2001-2008 Six Apart.
3322All rights reserved.
3323
3324=cut
Note: See TracBrowser for help on using the browser.