root/branches/release-28/lib/MT.pm.pre @ 1275

Revision 1275, 100.1 kB (checked in by fumiakiy, 23 months ago)

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