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

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

Forward-porting r1784 to the current dev branch.
  • 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        $tmpl_file = $file unless ref($file);
2131    }
2132
2133    if (($mode && ($mode !~ m/delete/)) && ($mt->{login_again} ||
2134        ($mt->{requires_login} && !$mt->user))) {
2135        ## If it's a login screen, direct the user to where they were going
2136        ## (query params including mode and all) unless they were logging in,
2137        ## logging out, or deleting something.
2138        my $q = $mt->{query};
2139        if ($mode) {
2140            my @query = map { {name => $_, value => scalar $q->param($_)}; }
2141                grep { ($_ ne 'username') && ($_ ne 'password') && ($_ ne 'submit') && ($mode eq 'logout' ? ($_ ne '__mode') : 1) } $q->param;
2142            $param->{query_params} = \@query;
2143        }
2144        $param->{login_again} = $mt->{login_again};
2145    }
2146
2147    my $blog = $mt->blog;
2148    $tmpl->context()->stash('blog', $blog) if $blog;
2149
2150    $tmpl->param($param) if $param;
2151
2152    if ($tmpl_file) {
2153        $tmpl_file = File::Basename::basename($tmpl_file);
2154        $tmpl_file =~ s/\.tmpl$//;
2155        $tmpl_file = '.' . $tmpl_file;
2156    }
2157    $mt->run_callbacks('template_param' . $tmpl_file, $mt, $tmpl->param, $tmpl);
2158
2159    my $output = $mt->build_page_in_mem($tmpl);
2160    return unless defined $output;
2161
2162    $mt->run_callbacks('template_output' . $tmpl_file, $mt, \$output, $tmpl->param, $tmpl);
2163    return $output;
2164}
2165
2166sub build_page_in_mem {
2167    my $mt = shift;
2168    my($tmpl, $param) = @_;
2169    $tmpl->param($param) if $param;
2170    my $out = $tmpl->output;
2171    return $mt->error($tmpl->errstr) unless defined $out;
2172    return $mt->translate_templatized($mt->process_mt_template($out));
2173}
2174
2175sub new_ua {
2176    my $class = shift;
2177    my ($opt) = @_;
2178    $opt ||= {};
2179    my $lwp_class = 'LWP::UserAgent';
2180    if ($opt->{paranoid}) {
2181        eval { require LWPx::ParanoidAgent; };
2182        $lwp_class = 'LWPx::ParanoidAgent' unless $@;
2183    }
2184    eval "require $lwp_class;";
2185    return undef if $@;
2186    my $cfg = $class->config;
2187    my $max_size = exists $opt->{max_size} ? $opt->{max_size} : 100_000;
2188    my $timeout = exists $opt->{timeout} ? $opt->{timeout} : $cfg->HTTPTimeout || $cfg->PingTimeout;
2189    my $proxy = exists $opt->{proxy} ? $opt->{proxy} : $cfg->HTTPProxy || $cfg->PingProxy;
2190    my $no_proxy = exists $opt->{no_proxy} ? $opt->{no_proxy} : $cfg->HTTPNoProxy || $cfg->PingNoProxy;
2191    my $agent = $opt->{agent} || 'MovableType/' . $MT::VERSION;
2192    my $interface = exists $opt->{interface} ? $opt->{interface} : $cfg->HTTPInterface || $cfg->PingInterface;
2193
2194    if ( my $localaddr = $interface ) {
2195        @LWP::Protocol::http::EXTRA_SOCK_OPTS = (
2196            LocalAddr => $localaddr,
2197            Reuse     => 1
2198        );
2199    }
2200
2201    my $ua = $lwp_class->new;
2202    $ua->max_size($max_size) if (defined $max_size) && $ua->can('max_size');
2203    $ua->agent( $agent );
2204    $ua->timeout( $timeout ) if defined $timeout;
2205    if ( defined $proxy ) {
2206        $ua->proxy( http => $proxy );
2207        my @domains = split( /,\s*/, $no_proxy ) if $no_proxy;
2208        $ua->no_proxy(@domains) if @domains;
2209    }
2210    return $ua;
2211}
2212
2213sub build_email {
2214    my $class = shift;
2215    my ( $file, $param ) = @_;
2216    my $mt = $class->instance;
2217
2218    # basically, try to load from database
2219    my $blog = $param->{blog} || undef;
2220    my $id = $file;
2221    $id =~ s/(\.tmpl|\.mtml)$//;
2222
2223    require MT::Template;
2224    my @tmpl = MT::Template->load(
2225        {
2226            ( $blog ? ( blog_id => [ $blog->id, 0 ] ) : ( blog_id => 0 ) ),
2227            identifier => $id,
2228            type       => 'email',
2229        }
2230    );
2231    my $tmpl =
2232      @tmpl
2233      ? (
2234        scalar @tmpl > 1
2235        ? ( $tmpl[0]->blog_id ? $tmpl[0] : $tmpl[1] )
2236        : $tmpl[0]
2237      )
2238      : undef;
2239
2240    # try to load from file
2241    unless ($tmpl) {
2242        local $mt->{template_dir} = 'email';
2243        $tmpl = $mt->load_tmpl($file);
2244    }
2245    return unless $tmpl;
2246
2247    my $ctx = $tmpl->context;
2248    $ctx->stash( 'blog',   delete $param->{'blog'} )   if $param->{'blog'};
2249    $ctx->stash( 'entry',  delete $param->{'entry'} )  if $param->{'entry'};
2250    $ctx->stash( 'author', delete $param->{'author'} ) if $param->{'author'};
2251    $ctx->stash( 'commenter', delete $param->{'commenter'} )
2252      if $param->{'commenter'};
2253    $ctx->stash( 'comment', delete $param->{'comment'} ) if $param->{'comment'};
2254    $ctx->stash( 'category', delete $param->{'category'} )
2255      if $param->{'category'};
2256    $ctx->stash( 'ping', delete $param->{'ping'} ) if $param->{'ping'};
2257
2258    foreach my $p (%$param) {
2259        if ( ref($p) ) {
2260            $tmpl->param( $p, $param->{$p} );
2261        }
2262    }
2263    return $mt->build_page_in_mem( $tmpl, $param );
2264}
2265
2266sub get_next_sched_post_for_user {
2267    my ( $author_id, @further_blog_ids ) = @_;
2268    require MT::Permission;
2269    my @perms = MT::Permission->load( { author_id => $author_id }, {} );
2270    my @blogs = @further_blog_ids;
2271    for my $perm (@perms) {
2272        next
2273          unless ( $perm->can_edit_config
2274            || $perm->can_publish_post
2275            || $perm->can_edit_all_posts );
2276        push @blogs, $perm->blog_id;
2277    }
2278    my $next_sched_utc = undef;
2279    require MT::Entry;
2280    for my $blog_id (@blogs) {
2281        my $blog           = MT::Blog->load($blog_id);
2282        my $earliest_entry = MT::Entry->load(
2283            {
2284                status  => MT::Entry::FUTURE(),
2285                blog_id => $blog_id
2286            },
2287            { 'sort' => 'created_on' }
2288        );
2289        if ($earliest_entry) {
2290            my $entry_utc =
2291              MT::Util::ts2iso( $blog, $earliest_entry->created_on );
2292            if ( $entry_utc < $next_sched_utc || !defined($next_sched_utc) ) {
2293                $next_sched_utc = $entry_utc;
2294            }
2295        }
2296    }
2297    return $next_sched_utc;
2298}
2299
2300our %Commenter_Auth;
2301
2302sub init_commenter_authenticators {
2303    my $self = shift;
2304    my $auths = $self->registry("commenter_authenticators") || {};
2305    foreach my $auth ( keys %$auths ) {
2306        delete $auths->{$auth}
2307          if exists( $auths->{$auth}->{condition} )
2308          && !( $auths->{$auth}->{condition}->() );
2309    }
2310    %Commenter_Auth = %$auths;
2311    $Commenter_Auth{$_}{key} ||= $_ for keys %Commenter_Auth;
2312}
2313
2314sub commenter_authenticator {
2315    my $self = shift;
2316    my ($key) = @_;
2317    %Commenter_Auth or $self->init_commenter_authenticators();
2318    return $Commenter_Auth{$key};
2319}
2320
2321sub commenter_authenticators {
2322    my $self = shift;
2323    %Commenter_Auth or $self->init_commenter_authenticators();
2324    return values %Commenter_Auth;
2325}
2326
2327sub _commenter_auth_params {
2328    my ( $key, $blog_id, $entry_id, $static ) = @_;
2329    my $params = {
2330        blog_id => $blog_id,
2331        static  => $static,
2332    };
2333    $params->{entry_id} = $entry_id if defined $entry_id;
2334    return $params;
2335}
2336
2337sub _openid_commenter_condition {
2338    eval "require Digest::SHA1;";
2339    return $@ ? 0 : 1;
2340}
2341
2342sub core_commenter_authenticators {
2343    return {
2344        'OpenID' => {
2345            class      => 'MT::Auth::OpenID',
2346            label      => 'OpenID',
2347            login_form => <<OpenID,
2348<form method="post" action="<mt:var name="script_url">">
2349<input type="hidden" name="__mode" value="login_external" />
2350<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2351<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2352<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2353<fieldset>
2354<mtapp:setting
2355    id="openid_display"
2356    label="<__trans phrase="OpenID URL">"
2357    hint="<__trans phrase="Sign in using your OpenID identity.">">
2358<input type="hidden" name="key" value="OpenID" />
2359<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%;" />
2360    <p class="hint"><__trans phrase="OpenID is an open and decentralized single sign-on identity system."></p>
2361</mtapp:setting>
2362
2363<div class="pkg">
2364<div class="left"><input type="submit" name="submit" value="<__trans phrase="Sign In">" /></div>
2365<div class="right"><img src="<mt:var name="static_uri">images/comment/openid_enabled.png" /></div>
2366</div>
2367<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>
2368</fieldset>
2369</form>
2370OpenID
2371            login_form_params => \&_commenter_auth_params,
2372            condition         => \&_openid_commenter_condition,
2373            logo              => 'images/comment/signin_openid.png',
2374            logo_small        => 'images/comment/openid_logo.png',
2375        },
2376        'LiveJournal' => {
2377            class      => 'MT::Auth::LiveJournal',
2378            label      => 'LiveJournal',
2379            login_form => <<LiveJournal,
2380<form method="post" action="<mt:var name="script_url">">
2381<input type="hidden" name="__mode" value="login_external" />
2382<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2383<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2384<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2385<input type="hidden" name="key" value="LiveJournal" />
2386<fieldset>
2387<mtapp:setting
2388    id="livejournal_display"
2389    label="<__trans phrase="Your LiveJournal Username">"
2390    hint="<__trans phrase="Sign in using your Vox blog URL">">
2391<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%;" />
2392</mtapp:setting>
2393<div class="actions-bar actions-bar-login">
2394    <div class="actions-bar-inner pkg actions">
2395        <button
2396            type="submit"
2397            class="primary-button"
2398            ><__trans phrase="Sign in"></button>
2399    </div>
2400</div>
2401<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>
2402</fieldset>
2403</form>
2404LiveJournal
2405            login_form_params => \&_commenter_auth_params,
2406            condition         => \&_openid_commenter_condition,
2407            logo              => 'images/comment/signin_livejournal.png',
2408            logo_small        => 'images/comment/livejournal_logo.png',
2409        },
2410        'Vox' => {
2411            class      => 'MT::Auth::Vox',
2412            label      => 'Vox',
2413            login_form => <<Vox,
2414<form method="post" action="<mt:var name="script_url">">
2415<input type="hidden" name="__mode" value="login_external" />
2416<input type="hidden" name="blog_id" value="<mt:var name="blog_id">" />
2417<input type="hidden" name="entry_id" value="<mt:var name="entry_id">" />
2418<input type="hidden" name="static" value="<mt:var name="static" escape="html">" />
2419<input type="hidden" name="key" value="Vox" />
2420<fieldset>
2421<mtapp:setting
2422    id="vox_display"
2423    label="<__trans phrase="Your Vox Blog URL">">
2424http:// <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
2425</mtapp:setting>
2426<div class="actions-bar actions-bar-login">
2427    <div class="actions-bar-inner pkg actions">
2428        <button
2429            type="submit"
2430            class="primary-button"
2431            ><__trans phrase="Sign in"></button>
2432    </div>
2433</div>
2434<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>
2435</fieldset>
2436</form>
2437Vox
2438            login_form_params => \&_commenter_auth_params,
2439            condition         => \&_openid_commenter_condition,
2440            logo              => 'images/comment/signin_vox.png',
2441            logo_small        => 'images/comment/vox_logo.png',
2442        },
2443        'TypeKey' => {
2444            class      => 'MT::Auth::TypeKey',
2445            label      => 'TypeKey',
2446            login_form => <<TypeKey,
2447<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>
2448<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>
2449TypeKey
2450            login_form_params => sub {
2451                my ( $key, $blog_id, $entry_id, $static ) = @_;
2452                my $entry = MT::Entry->load($entry_id) if $entry_id;
2453
2454                ## TypeKey URL
2455                require MT::Template::Context;
2456                my $ctx = MT::Template::Context->new;
2457                $ctx->stash( 'blog_id', $blog_id );
2458                my $blog = MT::Blog->load($blog_id);
2459                $ctx->stash( 'blog',  $blog );
2460                $ctx->stash( 'entry', $entry );
2461                my $params = {};
2462                $params->{tk_signin_url} =
2463                  MT::Template::Context::_hdlr_remote_sign_in_link( $ctx,
2464                    { static => $static } );
2465                return $params;
2466            },
2467            logo => 'images/comment/signin_typekey.png',
2468            logo_small        => 'images/comment/typekey_logo.png',
2469        },
2470    };
2471}
2472
2473our %Captcha_Providers;
2474
2475sub captcha_provider {
2476    my $self = shift;
2477    my ($key) = @_;
2478    $self->init_captcha_providers() unless %Captcha_Providers;
2479    return $Captcha_Providers{$key};
2480}
2481
2482sub captcha_providers {
2483    my $self = shift;
2484    $self->init_captcha_providers() unless %Captcha_Providers;
2485    my $def  = delete $Captcha_Providers{'mt_default'};
2486    my @vals = values %Captcha_Providers;
2487    if ( defined($def) && $def->{condition}->() ) {
2488        unshift @vals, $def;
2489    }
2490    @vals;
2491}
2492
2493sub core_captcha_providers {
2494    return {
2495        'mt_default' => {
2496            label     => 'Movable Type default',
2497            class     => 'MT::Util::Captcha',
2498            condition => sub {
2499                require MT::Util::Captcha;
2500                if ( my $error = MT::Util::Captcha->check_availability ) {
2501                    return 0;
2502                }
2503                1;
2504            },
2505        }
2506    };
2507}
2508
2509sub init_captcha_providers {
2510    my $self = shift;
2511    my $providers = $self->registry("captcha_providers") || {};
2512    foreach my $provider ( keys %$providers ) {
2513        delete $providers->{$provider}
2514          if exists( $providers->{$provider}->{condition} )
2515          && !( $providers->{$provider}->{condition}->() );
2516    }
2517    %Captcha_Providers = %$providers;
2518    $Captcha_Providers{$_}{key} ||= $_ for keys %Captcha_Providers;
2519}
2520
2521sub effective_captcha_provider {
2522    my $class = shift;
2523    my ($key) = @_;
2524    return undef unless $key;
2525    my $cp = $class->captcha_provider($key) or return;
2526    if ( exists $cp->{condition} ) {
2527        return undef unless $cp->{condition}->();
2528    }
2529    my $pkg = $cp->{class};
2530    $pkg =~ s/;//g;
2531    eval "require $pkg" or return;
2532    return $cp->{class};
2533}
2534
2535sub handler_to_coderef {
2536    my $pkg = shift;
2537    my ( $name, $delayed ) = @_;
2538
2539    return $name if ref($name) eq 'CODE';
2540    return undef unless defined $name && $name ne '';
2541
2542    my $code;
2543    if ( $name !~ m/->/ ) {
2544
2545        # check for Package::Routine first; if defined, return coderef
2546        no strict 'refs';
2547        $code = \&$name if defined &$name;
2548        return $code if $code;
2549    }
2550
2551    my $component;
2552    if ( $name =~ m!^\$! ) {
2553        if ( $name =~ s/^\$(\w+)::// ) {
2554            $component = $1;
2555        }
2556    }
2557    if ( $name =~ m/^\s*sub\s*\{/s ) {
2558        $code = eval $name or die $@;
2559
2560        if ($component) {
2561            return sub {
2562                my $mt_inst = MT->instance;
2563                local $mt_inst->{component} = $component;
2564                $code->(@_);
2565            };
2566        }
2567        else {
2568            return $code;
2569        }
2570    }
2571
2572    my $hdlr_pkg = $name;
2573    my $method;
2574    if ( $hdlr_pkg =~ s/(->|::)([^:]+)$// ) {    # strip routine name
2575        $method = $2 if $1 eq '->';
2576    }
2577    if ( !defined(&$name) && !$pkg->can( 'AUTOLOAD' ) ) {
2578
2579        # The delayed option will return a coderef that delays the loading
2580        # of the package holding the handler routine.
2581        if ($delayed) {
2582            if ($method) {
2583                return sub {
2584                    eval "require $hdlr_pkg;"
2585                      or Carp::confess(
2586                        "failed loading package $hdlr_pkg for routine $name: $@");
2587                    my $mt_inst = MT->instance;
2588                    local $mt_inst->{component} = $component
2589                      if $component;
2590                    return $hdlr_pkg->$method(@_);
2591                };
2592            }
2593            else {
2594                return sub {
2595                    eval "require $hdlr_pkg;"
2596                      or Carp::confess(
2597                        "failed loading package $hdlr_pkg for routine $name: $@");
2598                    my $mt_inst = MT->instance;
2599                    local $mt_inst->{component} = $component
2600                      if $component;
2601                    no strict 'refs';
2602                    my $hdlr = \&$name;
2603                    use strict 'refs';
2604                    return $hdlr->(@_);
2605                };
2606            }
2607        }
2608        else {
2609            eval "require $hdlr_pkg;"
2610              or Carp::confess(
2611                "failed loading package $hdlr_pkg for routine $name: $@");
2612        }
2613    }
2614    if ($method) {
2615        $code = sub {
2616            my $mt_inst = MT->instance;
2617            local $mt_inst->{component} = $component
2618              if $component;
2619            return $hdlr_pkg->$method(@_);
2620        };
2621    }
2622    else {
2623        if ($component) {
2624            $code = sub {
2625                no strict 'refs';
2626                my $hdlr = (
2627                    defined &$name ? \&$name
2628                    : ( $pkg->can( 'AUTOLOAD' ) ? \&$name
2629                        : undef )
2630                );
2631                use strict 'refs';
2632                if ($hdlr) {
2633                    my $mt_inst = MT->instance;
2634                    local $mt_inst->{component} = $component
2635                      if $component;
2636                    return $hdlr->(@_);
2637                }
2638                return undef;
2639              }
2640        }
2641        else {
2642            no strict 'refs';
2643            $code =
2644              (
2645                defined &$name
2646                ? \&$name
2647                : ( $hdlr_pkg->can( 'AUTOLOAD' ) ? \&$name : undef )
2648              );
2649        }
2650    }
2651    return $code;
2652}
2653
2654sub help_url {
2655    my $pkg = shift;
2656    my ( $append ) = @_;
2657
2658    my $url = $pkg->config->HelpURL;
2659    return $url if defined $url;
2660    $url = $pkg->translate('http://www.movabletype.org/documentation/');
2661    if ( $append ) {
2662        $url .= $append;
2663    }
2664    $url;
2665}
2666
2667sub register_refresh_cache_event {
2668    my $pkg = shift;
2669    my ($callback) = @_;
2670    return unless $callback;
2671
2672    MT->_register_core_callbacks({
2673        "$callback" => \&refresh_cache,
2674    });
2675}
2676
2677sub refresh_cache {
2678    my ($cb, %args) = @_;
2679
2680    require MT::Cache::Negotiate;
2681    my $cache_driver = MT::Cache::Negotiate->new();
2682    return unless $cache_driver;
2683
2684    $cache_driver->flush_all();
2685}
2686
2687sub DESTROY {
2688    # save_config here so not to miss any dirty config change to persist
2689    # particulary for those which does not construct MT::App.
2690    $_[0]->config->save_config();
2691}
2692
26931;
2694
2695__END__
2696
2697=head1 NAME
2698
2699MT - Movable Type
2700
2701=head1 SYNOPSIS
2702
2703    use MT;
2704    my $mt = MT->new;
2705    $mt->rebuild(BlogID => 1)
2706        or die $mt->errstr;
2707
2708=head1 DESCRIPTION
2709
2710The I<MT> class is the main high-level rebuilding/pinging interface in the
2711Movable Type library. It handles all rebuilding operations. It does B<not>
2712handle any of the application functionality--for that, look to I<MT::App> and
2713I<MT::App::CMS>, both of which subclass I<MT> to handle application requests.
2714
2715=head1 PLUGIN APPLICATIONS
2716
2717At any given time, the user of the Movable Type platform is
2718interacting with either the core Movable Type application, or a plugin
2719application (or "sub-application").
2720
2721A plugin application is a plugin with a user interface that inherits
2722functionality from Movable Type, and appears to the user as a
2723component of Movable Type. A plugin application typically has its own
2724templates displaying its own special features; but it inherits some
2725templates from Movable Type, such as the navigation chrome and error
2726pages.
2727
2728=head2 The MT Root and the Application Root
2729
2730To locate assets of the core Movable Type application and any plugin
2731applications, the platform uses two directory paths, C<mt_dir> and
2732C<app_dir>. These paths are returned by the MT class methods with the
2733same names, and some other methods return derivatives of these paths.
2734
2735Conceptually, mt_dir is the root of the Movable Type installation, and
2736app_dir is the root of the "currently running application", which
2737might be Movable Type or a plugin application. It is important to
2738understand the distinction between these two values and what each is
2739used for.
2740
2741The I<mt_dir> is the absolute path to the directory where MT itself is
2742located. Most importantly, the MT configuration file and the CGI scripts that
2743bootstrap an MT request are found here. This directory is also the
2744default base path under which MT's core templates are found (but this
2745can be overridden using the I<TemplatePath> configuration setting).
2746
2747Likewise, the I<app_dir> is the directory where the "current"
2748application's assets are rooted. The platform will search for
2749application templates underneath the I<app_dir>, but this search also
2750searches underneath the I<mt_dir>, allowing the application to make
2751use of core headers, footers, error pages, and possibly other
2752templates.
2753
2754In order for this to be useful, the plugin's templates and
2755code should all be located underneath the same directory. The relative
2756path from the I<app_dir> to the application's templates is
2757configurable. For details on how to indicate the location of your
2758plugin's templates, see L<MT::App>.
2759
2760=head2 Finding the Root Paths
2761
2762When a plugin application initializes its own application class (a
2763subclass of MT::App), the I<mt_dir> should be discovered and passed
2764constructor. This comes either from the C<Directory> parameter or the
2765C<Config> parameter.
2766
2767Since plugins are loaded from a descendent of the MT root directory,
2768the plugin bootstrap code can discover the MT configuration file (and thus
2769the MT root directory) by traversing the filesystem; the absolute path
2770to that file can be passed as the C<Config> parameter to
2771MT::App::new. Working code to do this can be found in the
2772examples/plugins/mirror/mt-mirror.cgi file.
2773
2774The I<app_dir>, on the other hand, always derives from the location of
2775the currently-running program, so it typically does not need to be
2776specified.
2777
2778=head1 USAGE
2779
2780I<MT> has the following interface. On failure, all methods return C<undef>
2781and set the I<errstr> for the object or class (depending on whether the
2782method is an object or class method, respectively); look below at the section
2783L<ERROR HANDLING> for more information.
2784
2785=head2 MT->new( %args )
2786
2787Constructs a new I<MT> instance and returns that object. Returns C<undef>
2788on failure.
2789
2790I<new> will also read your MT configuration file (provided that it can find it--if
2791you find that it can't, take a look at the I<Config> directive, below). It
2792will also initialize the chosen object driver; the default is the C<DBM>
2793object driver.
2794
2795I<%args> can contain:
2796
2797=over 4
2798
2799=item * Config
2800
2801Path to the MT configuration file.
2802
2803If you do not specify a path, I<MT> will try to find your MT configuration file
2804in the current working directory.
2805
2806=item * Directory
2807
2808Path to the MT home directory.
2809
2810If you do not specify a path, I<MT> will try to find the MT directory using
2811the discovered path of the MT configuration file.
2812
2813=back
2814
2815=head2 $mt->init
2816
2817Initializes the Movable Type instance, including registration of basic
2818resources and callbacks. This method also invokes the C<init_config>
2819and C<init_plugins> methods.
2820
2821=head2 MT->instance
2822
2823MT and all it's subclasses are now singleton classes, meaning you can only
2824have one instance per package. MT->instance() returns the active instance.
2825MT->new() is now an alias to instance_of.
2826
2827=head2 $class->instance_of
2828
2829Returns the singleton instance of the MT subclass identified by C<$class>.
2830
2831=head2 $class->construct
2832
2833Constructs a new instance of the MT subclass identified by C<$class>.
2834
2835=head2 MT->set_instance
2836
2837Assigns the active MT instance object. This value is returned when
2838C<MT-E<gt>instance> is invoked.
2839
2840=head2 $mt->find_config($params)
2841
2842Handles the discovery of the MT configuration file. The path and filename
2843for the configuration file is returned as the result. The C<$params>
2844parameter is a reference to the hash of settings passed to the MT
2845constructor.
2846
2847=head2 $mt->init_config($params)
2848
2849Reads the MT configuration settingss from the MT configuration file
2850and settings from database (L<MT::Config>).
2851
2852The C<$params> parameter is a reference to the hash of settings passed to
2853the MT constructor.
2854
2855=head2 $mt->init_plugins
2856
2857Loads any discoverable plugins that are available. This is called from
2858the C<init> method, after the C<init_config> method has loaded the
2859configuration settings.
2860
2861=head2 $mt->init_tasks
2862
2863Registers the standard set of periodic tasks that Movable Type provides
2864and then invokes the C<init_tasks> method for each available plugin.
2865
2866=head2 MT->run_tasks
2867
2868Initializes the tasks, running C<init_tasks> and invokes the task system
2869through L<MT::TaskMgr> to run any registered tasks that are pending
2870execution. See L<MT::TaskMgr> for further documentation.
2871
2872=head2 MT->unplug
2873
2874Removes the global reference to the MT instance.
2875
2876=head2 MT::log( $message ) or $mt->log( $message )
2877
2878Adds an entry to the application's log table. Also writes message to
2879STDERR which is typically routed to the web server's error log.
2880
2881=head2 $mt->server_path, $mt->mt_dir
2882
2883Both of these methods return the physical file path to the directory
2884that is the home of the MT installation. This would be the value of
2885the 'Directory' parameter given in the MT constructor, or would be
2886determined based on the path of the configuration file.
2887
2888=head2 $mt->app_dir
2889
2890Returns the physical file path to the active application directory. This
2891is determined by the directory of the active script.
2892
2893=head2 $mt->config_dir
2894
2895Returns the path to the MT configuration file.
2896
2897=head2 $mt->config([$setting[, $value]])
2898
2899This method is used to get and set configuration settings. When called
2900without any parameters, it returns the active MT::ConfigMgr instance
2901used by the application.
2902
2903Specifying the C<$setting> parameter will return the value for that setting.
2904When passing the C<$value> parameter, this will update the config object,
2905assigning that value for the named C<$setting>.
2906
2907=head2 $mt->user_class
2908
2909Returns the package name for the class used for user authentication.
2910This is typically L<MT::Author>.
2911
2912=head2 $mt->request([$element[,$data]])
2913
2914The request method provides a request-scoped storage object. It is an
2915access interface for the L<MT::Request> package. Calling without any
2916parameters will return the L<MT::Request> instance.
2917
2918When called with the C<$element> parameter, the data stored for that
2919element is returned (or undef, if it didn't exist). When called with
2920the C<$data> parameter, it will store the data into the specified
2921element in the request object.
2922
2923All values placed in the request object are lost at the end of the
2924request. If the running application is not a web-based application,
2925the request object exists for the lifetime of the process and is
2926released when the process ends.
2927
2928See the L<MT::Request> package for more information.
2929
2930=head2 MT->new_ua
2931
2932Returns a new L<LWP::UserAgent> instance that is configured according to the
2933Movable Type configuration settings (specifically C<HTTPInterface>, C<HTTPTimeout>, C<HTTPProxy> and C<HTTPNoProxy>). The agent string is set
2934to "MovableType/(version)" and is also limited to receiving a response of
2935100,000 bytes by default (you can override this by using the 'max_size'
2936method on the returned instance). Using this method is recommended for
2937any HTTP requests issued by Movable Type since it uses the MT configuration
2938settings to prepare the UserAgent object.
2939
2940=head2 $mt->ping( %args )
2941
2942Sends all configured XML-RPC pings as a way of notifying other community
2943sites that your blog has been updated.
2944
2945I<%args> can contain:
2946
2947=over 4
2948
2949=item * Blog
2950
2951An I<MT::Blog> object corresponding to the blog for which you would like to
2952send the pings.
2953
2954Either this or C<BlogID> is required.
2955
2956=item * BlogID
2957
2958The ID of the blog for which you would like to send the pings.
2959
2960Either this or C<Blog> is required.
2961
2962=back
2963
2964=head2 $mt->ping_and_save( %args )
2965
2966Handles the task of issuing any pending ping operations for a given
2967entry and then saving that entry back to the database.
2968
2969The I<%args> hash should contain an element named C<Entry> that is a
2970reference to a L<MT::Entry> object.
2971
2972=head2 $mt->needs_ping(%param)
2973
2974Returns a list of URLs that have not been pinged for a given entry. Named
2975parameters for this method are:
2976
2977=over 4
2978
2979=item Entry
2980
2981The L<MT::Entry> object to examine.
2982
2983=item Blog
2984
2985The L<MT::Blog> object that is the parent of the entry given.
2986
2987=back
2988
2989The return value is an array reference of URLs that have not been pinged
2990for the given entry.
2991
2992An empty list is returned for entries that have a non 'RELEASE' status.
2993
2994=head2 $mt->update_ping_list($blog)
2995
2996Returns a list of URLs for ping services that have been configured to
2997be notified when posting new entries.
2998
2999=head2 $mt->set_language($tag)
3000
3001Loads the localization plugin for the language specified by I<$tag>, which
3002should be a valid and supported language tag--see I<supported_languages> to
3003obtain a list of supported languages.
3004
3005The language is set on a global level, and affects error messages and all
3006text in the administration system.
3007
3008This method can be called as either a class method or an object method; in
3009other words,
3010
3011    MT->set_language($tag)
3012
3013will also work. However, the setting will still be global--it will not be
3014specified to the I<$mt> object.
3015
3016The default setting--set when I<MT::new> is called--is U.S. English. If a
3017I<DefaultLanguage> is set in the MT configuration file, the default is then
3018set to that language.
3019
3020=head2 MT->translate($str[, $param, ...])
3021
3022Translates I<$str> into the currently-set language (set by I<set_language>),
3023and returns the translated string. Any parameters following I<$str> are
3024passed through to the C<maketext> method of the active localization module.
3025
3026=head2 MT->translate_templatized($str)
3027
3028Translates a string that has embedded E<lt>MT_TRANSE<gt> tags. These
3029tags identify the portions of the string that require localization.
3030Each tag is processed separately and passed through the MT->translate
3031method. Examples (used in your application's HTML::Template templates):
3032
3033    <p><MT_TRANS phrase="Hello, world"></p>
3034
3035and
3036
3037    <p><MT_TRANS phrase="Hello, [_1]" params="<TMPL_VAR NAME=NAME>"></p>
3038
3039=head2 $mt->trans_error( $str[, $arg1, $arg2] )
3040
3041Translates I<$str> into the currently-set language (set by I<set_language>),
3042and assigns it as the active error for the MT instance. It returns undef,
3043which is the usual return value upon generating an error in the application.
3044So when an error occurs, the typical return result would be:
3045
3046    if ($@) {
3047        return $app->trans_error("An error occurred: [_1]", $@);
3048    }
3049
3050The optional I<$arg1> (and so forth) parameters are passed as parameters to
3051any parameterized error message.
3052
3053=head2 $mt->current_language
3054
3055Returns the language tag for the currently-set language.
3056
3057=head2 MT->supported_languages
3058
3059Returns a reference to an associative array mapping language tags to their
3060proper names. For example:
3061
3062    use MT;
3063    my $langs = MT->supported_languages;
3064    print map { $_ . " => " . $langs->{$_} . "\n" } keys %$langs;
3065
3066=head2 MT->language_handle
3067
3068Returns the active MT::L10N language instance for the active language.
3069
3070=head2 MT->add_plugin($plugin)
3071
3072Adds the plugin described by $plugin to the list of plugins displayed
3073on the welcome page. The argument should be an object of the
3074I<MT::Plugin> class.
3075
3076=head2 MT->all_text_filters
3077
3078Returns a reference to a hash containing the registry of text filters.
3079
3080=head2 MT->apply_text_filters($str, \@filters)
3081
3082Applies the set of filters I<\@filters> to the string I<$str> and returns
3083the result (the filtered string).
3084
3085I<\@filters> should be a reference to an array of filter keynames--these
3086are the short names passed in as the first argument to I<add_text_filter>.
3087I<$str> should be a scalar string to be filtered.
3088
3089If one of the filters listed in I<\@filters> is not found in the list of
3090registered filters (that is, filters added through I<add_text_filter>),
3091it will be skipped silently. Filters are executed in the order in which they
3092appear in I<\@filters>.
3093
3094As it turns out, the I<MT::Entry::text_filters> method returns a reference
3095to the list of text filters to be used for that entry. So, for example, to
3096use this method to apply filters to the main entry text for an entry
3097I<$entry>, you would use
3098
3099    my $out = MT->apply_text_filters($entry->text, $entry->text_filters);
3100
3101=head2 MT->add_callback($meth, $priority, $plugin, $code)
3102
3103Registers a new callback handler for a particular registered callback.
3104
3105The first parameter is the name of the callback method. The second
3106parameter is a priority (a number in the range of 1-10) which will control
3107the order that the handler is executed in relation to other handlers. If
3108two handlers register with the same priority, they will be executed in
3109the order that they registered. The third parameter is a C<MT::Plugin> object
3110reference that is associated with the handler (this parameter is optional).
3111The fourth parameter is a code reference that is invoked to handle the
3112callback. For example:
3113
3114    MT->add_callback('BuildFile', 1, undef, \&rebuild_file_hdlr);
3115
3116The code reference should expect to receive an object of type
3117L<MT::Callback> as its first argument. This object is used to
3118communicate errors to the caller:
3119
3120    sub rebuild_file_hdlr {
3121        my ($cb, ...) = @_;
3122        if (something bad happens) {
3123            return $cb->error("Something bad happened!");
3124        }
3125    }
3126
3127Other parameters to the callback function depend on the callback point.
3128
3129The treatment of the error string depends on the callback point.
3130Typically, either it is ignored or the user's action fails and the
3131error message is displayed.
3132
3133The value returned from this method is the new L<MT::Callback> object.
3134
3135=head2 MT->remove_callback($callback)
3136
3137Removes a callback that was previously registered.
3138
3139=head2 MT->register_callbacks([...])
3140
3141Registers several callbacks simultaneously. Each element in the array
3142parameter given should be a hashref containing these elements: C<name>,
3143C<priority>, C<plugin> and C<code>.
3144
3145=head2 MT->run_callbacks($meth[, $arg1, $arg2, ...])
3146
3147Invokes a particular callback, running any associated callback handlers.
3148
3149The first parameter is the name of the callback to execute. This is one
3150of the global callback methods (see L<Callbacks> section) or can be
3151a class-specific method that includes the package name associated with
3152the callback.
3153
3154The remaining arguments are passed through to any callback handlers that
3155are invoked.
3156
3157For "Filter"-type callbacks, this routine will return a 0 if any of the
3158handlers return a false result. If all handlers return a true result,
3159a value of 1 is returned.
3160
3161Example:
3162
3163    MT->run_callbacks('MyClass::frobnitzes', \@whirlygigs);
3164
3165Which would execute any handlers that registered in this fashion:
3166
3167    MT->add_callback('MyClass::frobnitzes', 4, $plugin, \&frobnitz_hdlr);
3168
3169=head2 MT->run_callback($cb[, $arg1, $arg2, ...])
3170
3171An internal routine used by C<run_callbacks> to invoke a single
3172L<MT::Callback>.
3173
3174=head2 callback_error($str)
3175
3176This routine is used internally by C<MT::Callback> to set any error response
3177that comes from invoking a callback.
3178
3179=head2 callback_errstr
3180
3181This internal routine returns the error response stored using the
3182C<callback_error> routine.
3183
3184=head2 MT->product_code
3185
3186The product code identifying the Movable Type product that is installed.
3187This is either 'MTE' for Movable Type Enterprise or 'MT' for the
3188non-Enterprise product.
3189
3190=head2 MT->product_name
3191
3192The name of the Movable Type product that is installed. This is either
3193'Movable Type Enterprise' or 'Movable Type Publishing Platform'.
3194
3195=head2 MT->product_version
3196
3197The version number of the product. This is different from the C<version_id>
3198and C<version_number> methods as they report the API version information.
3199
3200=head2 MT->version_id
3201
3202Returns the API version of MT (including any beta/alpha designations).
3203
3204=head2 MT->version_number
3205
3206Returns the numeric API version of MT (without any beta/alpha designations).
3207For example, if I<version_id> returned C<2.5b1>, I<version_number> would
3208return C<2.5>.
3209
3210=head2 MT->schema_version
3211
3212Returns the version of the MT database schema.
3213
3214=head2 MT->version_slug
3215
3216Returns a string of text that is appended to emails sent through the
3217C<build_email> method.
3218
3219=head2 $mt->publisher
3220
3221Returns the L<MT::WeblogPublisher> object that is used for managing the
3222MT publishing process. See L<MT::WeblogPublisher> for more information.
3223
3224=head2 $mt->rebuild
3225
3226An alias to L<MT::WeblogPublisher::rebuild>. See L<MT::WeblogPublisher>
3227for documentation of this method.
3228
3229=head2 $mt->rebuild_entry
3230
3231An alias to L<MT::WeblogPublisher::rebuild_entry>. See L<MT::WeblogPublisher>
3232for documentation of this method.
3233
3234=head2 $mt->rebuild_indexes
3235
3236An alias to L<MT::WeblogPublisher::rebuild_indexes>. See
3237L<MT::WeblogPublisher> for documentation of this method.
3238
3239=head2 $mt->build_email($file, $param)
3240
3241Loads a template from the application's 'email' template directory and
3242processes it as a HTML::Template. The C<$param> argument is a hash reference
3243of parameter data for the template. The return value is the output of the
3244template.
3245
3246=head2 MT::get_next_sched_post_for_user($author_id, @blog_ids)
3247
3248This is an internal routine used by L<MT::XMLRPCServer> and the
3249getNextScheduled XMLRPC method to determine the timestamp for the next
3250entry that is scheduled for publishing. The return value is the timestamp
3251in UTC time in the format "YYYY-MM-DDTHH:MM:SSZ".
3252
3253=head1 ERROR HANDLING
3254
3255On an error, all of the above methods return C<undef>, and the error message
3256can be obtained by calling the method I<errstr> on the class or the object
3257(depending on whether the method called was a class method or an instance
3258method).
3259
3260For example, called on a class name:
3261
3262    my $mt = MT->new or die MT->errstr;
3263
3264Or, called on an object:
3265
3266    $mt->rebuild(BlogID => $blog_id)
3267        or die $mt->errstr;
3268
3269=head1 DEBUGGING
3270
3271MT has a package variable C<$MT::DebugMode> which is assigned through
3272your MT configuration file (DebugMode setting). If this is set to
3273any non-zero value, MT applications will display any C<warn>'d
3274statements to a panel that is displayed within the app.
3275
3276The DebugMode is a bit-wise setting and offers the following options:
3277
3278    1 - Display debug messages
3279    2 - Display a stack trace for messages captured
3280    4 - Lists queries issued by Data::ObjectDriver
3281    8 - Reports on MT templates that take more than 1/4 second to build*
3282    128 - Outputs app-level request/response information to STDERR.
3283
3284These can be combined, so if you want to display queries and debug messages,
3285use a DebugMode of 5 for instance.
3286
3287You may also use the local statement to temporarily apply a particular bit,
3288if you want to scope the debug messages you receive to a block of code:
3289
3290    local $MT::DebugMode |= 4;  # show me the queries for the following
3291    my $obj = MT::Entry->load({....});
3292
3293*DebugMode bit 8 actually outputs it's messages to STDERR (which typically
3294is sent to your web server's error log).
3295
3296=head1 CALLBACKS
3297
3298Movable Type has a variety of hook points at which a plugin can attach
3299a callback.
3300
3301In each case, the first parameter is an L<MT::Callback> object which
3302can be used to pass error information back to the caller.
3303
3304The app-level callbacks related to rebuilding are documented
3305in L<MT::WeblogPublisher>. The specific apps document the callbacks
3306which they invoke.
3307
3308=head2 NewUserProvisioning($cb, $user)
3309
3310This callback is invoked when a user is being added to Movable Type.
3311Movable Type itself registers for this callback (with a priority of 5)
3312to provision the user with a new weblog if the system has been configured
3313to do so.
3314
3315=head1 LICENSE
3316
3317The license that applies is the one you agreed to when downloading
3318Movable Type.
3319
3320=head1 AUTHOR & COPYRIGHT
3321
3322Except where otherwise noted, MT is Copyright 2001-2008 Six Apart.
3323All rights reserved.
3324
3325=cut
Note: See TracBrowser for help on using the browser.