Context Navigation

App.pm @ 1372

Visit:

Revision 1372, 124.1 kB (checked in by bchoate, 22 months ago)
Initial work for performance logging.
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
7	package MT::App;
8
9	use strict;
10	use base qw( MT );
11
12	use File::Spec;
13	use MT::Request;
14	use MT::Util qw( encode_html offset_time_list decode_html encode_url is_valid_email is_url );
15	use MT::I18N qw( encode_text wrap_text );
16
17	my $COOKIE_NAME = 'mt_user';
18	use constant COMMENTER_COOKIE_NAME => "mt_commenter";
19	use vars qw( %Global_actions );
20
21	sub core_menus {
22	return {};
23	}
24
25	sub core_methods {
26	return {};
27	}
28
29	sub core_page_actions {
30	return {};
31	}
32
33	sub core_list_actions {
34	return {};
35	}
36
37	sub core_list_filters {
38	{}
39	}
40
41	sub core_widgets {
42	{}
43	}
44
45	sub core_blog_stats_tabs {
46	{}
47	}
48
49	sub core_search_apis {
50	{}
51	}
52
53	sub __massage_page_action {
54	my ($app, $action, $type) = @_;
55	return if exists $action->{__massaged};
56
57	# my $plugin_sig = $action->{plugin};
58	my $plugin = $action->{plugin};
59
60	if (my $link = $action->{link}) {
61	my $envelope = $plugin->envelope;
62	$link .= '?' unless $link =~ m.\?.;
63	my $page = $app->config->AdminCGIPath \|\| $app->config->CGIPath;
64	$page .= '/' unless $page =~ m!/$!;
65	$page .= $envelope . '/' if $envelope;
66	$page .= $link;
67	my $has_params = ($page =~ m/\?/)
68	&& ($page !~ m!(&\|;\|\?)$!);
69	$action->{page} = $page;
70	$action->{page_has_params} = $has_params;
71	} elsif ($action->{mode} \|\| $action->{dialog}) {
72	if ( $app->user->is_superuser ) {
73	$action->{allowed} = 1;
74	}
75	else {
76	my $perms = $app->permissions;
77	if ( my $p = $action->{permission} ) {
78	my @p = split /,/, $p;
79	foreach my $p (@p) {
80	my $perm = 'can_' . $p;
81	$action->{allowed} = 1, last if ( $perms && $perms->$perm() );
82	}
83	}
84	}
85	if ( $action->{mode} ) {
86	$action->{link} = $app->uri(
87	mode => $action->{mode},
88	args => $action->{args}
89	);
90	}
91	elsif ( $action->{dialog} ) {
92	if ( $action->{args} ) {
93	my @args = map { $_ . '=' . $action->{args}->{$_} } keys %{ $action->{args} };
94	$action->{dialog_args} .= join '&', @args;
95	}
96	}
97	} else {
98	$action->{page} = $app->uri(mode => 'page_action', args => { action_name => $action->{key}, '_type' => $type } );
99	$action->{page_has_params} = 1;
100	}
101	$action->{core} = $plugin->isa('MT::Plugin') ? 0 : 1;
102	$action->{order} = -10000 + ($action->{order} \|\| 0) if $action->{core};
103	$action->{label} = $action->{link_text} if exists $action->{link_text};
104	if ($plugin && !ref($action->{label})) {
105	my $label = $action->{label};
106	if ($plugin) {
107	$action->{label} = sub { $plugin->translate($label) };
108	} else {
109	$action->{label} = sub { $app->translate($label) };
110	}
111	}
112
113	$action->{__massaged} = 1;
114	}
115
116	sub filter_conditional_list {
117	my ($app, $list, @param) = @_;
118
119	# $list may either be an array of things or a hashref of things
120
121	my $perms = $app->permissions;
122	my $user = $app->user;
123	my $admin = ($user && $user->is_superuser())
124	\|\| ($perms && $perms->blog_id && $perms->has('administer_blog'));
125	my $system_perms = $user->permissions(0) unless $perms && $perms->blog_id;
126
127	my $test = sub {
128	my ($item) = @_;
129	if ( $system_perms
130	&& (my $sp = $item->{system_permission}) ) {
131	my $allowed = 0;
132	my @sp = split /,/, $sp;
133	foreach my $sp (@sp) {
134	my $perm = 'can_' . $sp;
135	$allowed = 1, last
136	if $admin \|\| ($system_perms && $system_perms->can($perm) && $system_perms->$perm());
137	}
138	return 0 unless $allowed;
139	}
140	if (my $p = $item->{permission}) {
141	my $allowed = 0;
142	my @p = split /,/, $p;
143	foreach my $p (@p) {
144	my $perm = 'can_' . $p;
145	$allowed = 1, last
146	if $admin \|\| ($perms && $perms->can($perm) && $perms->$perm());
147	}
148	return 0 unless $allowed;
149	}
150	if (my $cond = $item->{condition}) {
151	if (!ref($cond)) {
152	$cond = $item->{condition} = $app->handler_to_coderef($cond);
153	}
154	return 0 unless $cond->(@param);
155	}
156	return 1;
157	};
158
159	if (ref $list eq 'ARRAY') {
160	my @list;
161	if (@$list) {
162	# translate the link text here...
163	foreach my $item (@$list) {
164	push @list, $item if $test->($item);
165	}
166	}
167	return \@list;
168	} elsif (ref $list eq 'HASH') {
169	my %list;
170	if (%$list) {
171	# translate the link text here...
172	foreach my $item (keys %$list) {
173	$list{$item} = $list->{$item}
174	if $test->($list->{$item});
175	}
176	}
177	return \%list;
178	}
179	return undef;
180	}
181
182	sub page_actions {
183	my $app = shift;
184	my ($type, @param) = @_;
185	my $actions = $app->registry("page_actions", $type) or return;
186	foreach my $a (keys %$actions) {
187	$actions->{$a}{key} = $a;
188	__massage_page_action($app, $actions->{$a}, $type);
189	}
190	my @actions = values %$actions;
191	$actions = $app->filter_conditional_list(\@actions, @param);
192	no warnings;
193	@$actions = sort { $a->{order} <=> $b->{order} } @$actions;
194	return $actions;
195	}
196
197	sub list_actions {
198	my $app = shift;
199	my ($type, @param) = @_;
200
201	my $actions = $app->registry("list_actions", $type) or return;
202	my @actions;
203	foreach my $a (keys %$actions) {
204	$actions->{$a}{key} = $a;
205	$actions->{$a}{core} = 1
206	unless UNIVERSAL::isa($actions->{$a}{plugin}, 'MT::Plugin');
207	if ( exists $actions->{$a}{continue_prompt_handler} ) {
208	my $code = $app->handler_to_coderef($actions->{$a}{continue_prompt_handler});
209	$actions->{$a}{continue_prompt} = $code->()
210	if 'CODE' eq ref($code);
211	}
212	push @actions, $actions->{$a};
213	}
214	$actions = $app->filter_conditional_list(\@actions, @param);
215	no warnings;
216	@$actions = sort { $a->{order} <=> $b->{order} } @$actions;
217	return $actions;
218	}
219
220	sub list_filters {
221	my $app = shift;
222	my ($type, @param) = @_;
223
224	my $filters = $app->registry("list_filters", $type) or return;
225	my @filters;
226	foreach my $a (keys %$filters) {
227	$filters->{$a}{key} = $a;
228	next if $a =~ m/^_/; # not shown...
229	push @filters, $filters->{$a};
230	}
231	$filters = $app->filter_conditional_list(\@filters, @param);
232	no warnings;
233	@$filters = sort { $a->{order} <=> $b->{order} } @$filters;
234	return $filters;
235	}
236
237	sub search_apis {
238	my $app = shift;
239	my ($view, @param) = @_;
240
241	my $apis = $app->registry("search_apis") or return;
242	my @apis;
243	foreach my $a (keys %$apis) {
244	next if $apis->{$a}->{view} && $apis->{$a}->{view} ne $view;
245	$apis->{$a}{key} = $a;
246	$apis->{$a}{core} = 1
247	unless UNIVERSAL::isa($apis->{$a}{plugin}, 'MT::Plugin');
248	push @apis, $apis->{$a};
249	}
250	$apis = $app->filter_conditional_list(\@apis, @param);
251	no warnings;
252	@$apis = sort { $a->{order} <=> $b->{order} } @$apis;
253	return $apis;
254	}
255
256	sub listing {
257	my $app = shift;
258	my ($opt) = @_;
259
260	my $type = $opt->{type} \|\| $opt->{Type} \|\| $app->param('_type');
261	my $tmpl = $opt->{template}
262	\|\| $opt->{Template}
263	\|\| 'list_' . $type . '.tmpl';
264	my $iter_method = $opt->{iterator} \|\| $opt->{Iterator} \|\| 'load_iter';
265	my $param = $opt->{params} \|\| $opt->{Params} \|\| {};
266	$param->{listing_screen} = 1;
267	my $add_pseudo_new_user = delete $param->{pseudo_new_user}
268	if exists $param->{pseudo_new_user};
269	my $hasher = $opt->{code} \|\| $opt->{Code};
270	my $terms = $opt->{terms} \|\| $opt->{Terms} \|\| {};
271	my $args = $opt->{args} \|\| $opt->{Args} \|\| {};
272	my $no_html = $opt->{no_html} \|\| $opt->{NoHTML};
273	my $no_limit = $opt->{no_limit} \|\| 0;
274	my $json = $opt->{json} \|\| $app->param('json');
275	my $pre_build = $opt->{pre_build} if ref($opt->{pre_build}) eq 'CODE';
276	$param->{json} = 1 if $json;
277
278	my $class = $app->model($type) or return;
279	my $list_pref = $app->list_pref($type);
280	$param->{$_} = $list_pref->{$_} for keys %$list_pref;
281	my $limit = $list_pref->{rows};
282	my $offset = $app->param('offset') \|\| 0;
283	$args->{offset} = $offset if $offset && !$no_limit;
284	$args->{limit} = $limit + 1 unless $no_limit;
285	$param->{limit_none} = 1 if $no_limit;
286
287	# handle search parameter
288	if ( my $search = $app->param('search') ) {
289	$app->param( 'do_search', 1 );
290	if ($app->can('do_search_replace')) {
291	my $search_param = $app->do_search_replace();
292	if ($hasher) {
293	my $data = $search_param->{object_loop};
294	if ( $data && @$data ) {
295	foreach my $row (@$data) {
296	my $obj = $row->{object};
297	$row = $obj->column_values();
298	$hasher->( $obj, $row );
299	}
300	}
301	}
302	$param->{$_} = $search_param->{$_} for keys %$search_param;
303	$param->{limit_none} = 1;
304	}
305	}
306	else {
307	# handle filter options
308	my $filter_key = $app->param('filter_key');
309	if ( !$filter_key && !$app->param('filter') ) {
310	$filter_key = 'default';
311	}
312	if ( $filter_key ) {
313
314	# set filter based on type
315	my $filter = $app->registry( "list_filters", $type, $filter_key );
316	if ($filter) {
317	if ( my $code = $filter->{code} \|\| $filter->{handler} ) {
318	if ( ref($code) ne 'CODE' ) {
319	$code = $filter->{code} =
320	$app->handler_to_coderef($code);
321	}
322	if ( ref($code) eq 'CODE' ) {
323	$code->( $terms, $args );
324	$param->{filter} = 1;
325	$param->{filter_key} = $filter_key;
326	$param->{filter_label} = $filter->{label};
327	}
328	}
329	}
330	}
331	if ( ( my $filter_col = $app->param('filter') )
332	&& ( my $val = $app->param('filter_val') ) )
333	{
334	if (
335	(
336	( $filter_col eq 'normalizedtag' )
337	\|\| ( $filter_col eq 'exacttag' )
338	)
339	&& ( $class->isa('MT::Taggable') )
340	)
341	{
342	my $normalize = ( $filter_col eq 'normalizedtag' );
343	my $tag_class = $app->model('tag');
344	my $ot_class = $app->model('objecttag');
345	my $tag_delim = chr( $app->user->entry_prefs->{tag_delim} );
346	my @filter_vals = $tag_class->split( $tag_delim, $val );
347	my @filter_tags = @filter_vals;
348	if ($normalize) {
349	push @filter_tags, MT::Tag->normalize($_)
350	foreach @filter_vals;
351	}
352	my @tags = $tag_class->load( { name => [@filter_tags] },
353	{ binary => { name => 1 } } );
354	my @tag_ids;
355	foreach (@tags) {
356	push @tag_ids, $_->id;
357	if ($normalize) {
358	my @more = $tag_class->load(
359	{ n8d_id => $_->n8d_id ? $_->n8d_id : $_->id } );
360	push @tag_ids, $_->id foreach @more;
361	}
362	}
363	@tag_ids = (0) unless @tags;
364	$args->{'join'} = $ot_class->join_on(
365	'object_id',
366	{
367	tag_id => \@tag_ids,
368	object_datasource => $class->datasource
369	},
370	{ unique => 1 }
371	);
372	}
373	elsif ( !exists( $terms->{$filter_col} ) ) {
374	if ($class->has_column($filter_col)) {
375	$terms->{$filter_col} = $val;
376	}
377	}
378	$param->{filter} = $filter_col;
379	$param->{filter_val} = $val;
380	my $url_val = encode_url($val);
381	$param->{filter_args} = "&filter=$filter_col&filter_val=$url_val";
382	$param->{"filter_col_$filter_col"} = 1;
383	}
384
385	# automagic blog scoping
386	my $blog = $app->blog;
387	if ($blog) {
388
389	# In blog context, class defines blog_id as a column,
390	# so restrict listing to active blog:
391	if ( $class->column_def('blog_id') ) {
392	$terms->{blog_id} \|\|= $blog->id;
393	}
394	}
395
396	$args->{sort} = 'id'
397	unless exists $args->{sort}; # must always provide sort column
398
399	$app->run_callbacks( 'app_pre_listing_'.$app->mode,
400	$app, $terms, $args, $param, \$hasher );
401
402	my $iter =
403	ref($iter_method) eq 'CODE'
404	? $iter_method
405	: ( $class->$iter_method( $terms, $args )
406	or return $app->error( $class->errstr ) );
407	my @data;
408	while ( my $obj = $iter->() ) {
409	my $row = $obj->column_values();
410	$hasher->( $obj, $row ) if $hasher;
411	#$app->run_callbacks( 'app_listing_'.$app->mode,
412	# $app, $obj, $row );
413	push @data, $row;
414	last if (scalar @data == $limit) && (!$no_limit);
415	}
416
417	$param->{object_loop} = \@data;
418
419	# handle pagination
420	my $pager = {
421	offset => $offset,
422	limit => $limit,
423	rows => scalar @data,
424	listTotal => $class->count( $terms, $args ),
425	chronological => $param->{list_noncron} ? 0 : 1,
426	return_args => $app->make_return_args,
427	method => $app->request_method,
428	};
429	$param->{object_type} \|\|= $type;
430	require JSON;
431	$param->{pager_json} = $json ? $pager : JSON::objToJson($pager);
432
433	# pager.rows (number of rows shown)
434	# pager.listTotal (total number of rows in datasource)
435	# pager.offset (offset currently used)
436	# pager.chronological (boolean, whether the listing is chronological or not)
437	}
438
439	my $plural = $type;
440
441	# entry -> entries; user -> users
442	if ( $class->can('class_label') ) {
443	$param->{object_label} = $class->class_label;
444	}
445	if ( $class->can('class_label_plural') ) {
446	$param->{object_label_plural} = $class->class_label_plural;
447	}
448
449	if ( $app->user->is_superuser() ) {
450	$param->{is_superuser} = 1;
451	}
452
453	if ($json) {
454	$pre_build->($param) if $pre_build;
455	my $html = $app->build_page( $tmpl, $param );
456	my $data = {
457	html => $html,
458	pager => $param->{pager_json},
459	};
460	$app->send_http_header("text/javascript+json");
461	require JSON;
462	$app->print( JSON::objToJson($data) );
463	$app->{no_print_body} = 1;
464	}
465	else {
466	$app->load_list_actions( $type, $param );
467	$pre_build->($param) if $pre_build;
468	if ($no_html) {
469	return $param;
470	}
471	if (ref $tmpl) {
472	$tmpl->param( $param );
473	return $tmpl;
474	} else {
475	return $app->load_tmpl( $tmpl, $param );
476	}
477	}
478	}
479
480	sub json_result {
481	my $app = shift;
482	my ($result) = @_;
483	$app->send_http_header("text/javascript+json");
484	$app->{no_print_body} = 1;
485	require JSON;
486	$app->print(JSON::objToJson( { error => undef, result => $result }));
487	return undef;
488	}
489
490	sub json_error {
491	my $app = shift;
492	my ($error) = @_;
493	$app->send_http_header("text/javascript+json");
494	$app->{no_print_body} = 1;
495	require JSON;
496	$app->print(JSON::objToJson( { error => $error } ));
497	return undef;
498	}
499
500	sub response_code {
501	my $app = shift;
502	$app->{response_code} = shift if @_;
503	$app->{response_code};
504	}
505
506	sub response_message {
507	my $app = shift;
508	$app->{response_message} = shift if @_;
509	$app->{response_message};
510	}
511
512	sub response_content_type {
513	my $app = shift;
514	$app->{response_content_type} = shift if @_;
515	$app->{response_content_type};
516	}
517
518	sub response_content {
519	my $app = shift;
520	$app->{response_content} = shift if @_;
521	$app->{response_content};
522	}
523
524	sub send_http_header {
525	my $app = shift;
526	my($type) = @_;
527	$type \|\|= $app->{response_content_type} \|\| 'text/html';
528	if (my $charset = $app->charset) {
529	$type .= "; charset=$charset"
530	if $type =~ m!^text/! && $type !~ /\bcharset\b/;
531	}
532	if ($ENV{MOD_PERL}) {
533	if ($app->{response_message}) {
534	$app->{apache}->status_line(($app->response_code \|\| 200)
535	. ($app->{response_message} ? ' ' . $app->{response_message} : ''));
536	} else {
537	$app->{apache}->status($app->response_code \|\| 200);
538	}
539	$app->{apache}->send_http_header($type);
540	if ($MT::DebugMode & 128) {
541	print "Status: " . ($app->response_code \|\| 200)
542	. ($app->{response_message} ? ' ' . $app->{response_message} : '')
543	. "\n";
544	print "Content-Type: $type\n\n";
545	}
546	} else {
547	$app->{cgi_headers}{-status} = ($app->response_code \|\| 200)
548	. ($app->{response_message} ? ' ' . $app->{response_message} : '');
549	$app->{cgi_headers}{-type} = $type;
550	$app->print($app->{query}->header(%{ $app->{cgi_headers} }));
551	}
552	}
553
554	sub print {
555	my $app = shift;
556	if ($ENV{MOD_PERL}) {
557	$app->{apache}->print(@_);
558	} else {
559	CORE::print(@_);
560	}
561	if ($MT::DebugMode & 128) {
562	CORE::print STDERR @_;
563	}
564	}
565
566	sub handler ($$) {
567	my $class = shift;
568	my($r) = @_;
569	require Apache::Constants;
570	if (lc($r->dir_config('Filter') \|\| '') eq 'on') {
571	$r = $r->filter_register;
572	}
573	my $config_file = $r->dir_config('MTConfig');
574	my $mt_dir = $r->dir_config('MTHome');
575	my %params = (Config => $config_file, ApacheObject => $r,
576	( $mt_dir ? ( Directory => $mt_dir ) : () ));
577	my $app = $class->new( %params )
578	or die $class->errstr;
579
580	MT->set_instance($app);
581	$app->init_request(%params);
582
583	my $cfg = $app->config;
584	if (my @extra = $r->dir_config('MTSetVar')) {
585	for my $d (@extra) {
586	my($var, $val) = $d =~ /^\s*(\S+)\s+(.+)$/;
587	$cfg->set($var, $val);
588	}
589	}
590
591	$app->run;
592	return Apache::Constants::OK();
593	}
594
595	sub new {
596	my $pkg = shift;
597	my $app = $pkg->SUPER::new(@_);
598	$app->{init_request} = 0;
599	$app;
600	}
601
602	sub init {
603	my $app = shift;
604	my %param = @_;
605	$app->{apache} = $param{ApacheObject} if exists $param{ApacheObject};
606	$app->SUPER::init(%param) or return;
607	$app->{vtbl} = { };
608	$app->{is_admin} = 0;
609	$app->{template_dir} = 'cms'; #$app->id;
610	$app->{user_class} = 'MT::Author';
611	$app->{plugin_template_path} = 'tmpl';
612	$app->run_callbacks('init_app', $app, @_);
613	if ($MT::DebugMode & 128) {
614	MT->add_callback('pre_run', 1, $app, sub { $app->pre_run_debug });
615	MT->add_callback('takedown', 1, $app, sub { $app->post_run_debug });
616	}
617	$app->{vtbl} = $app->registry("methods");
618	$app->init_request(@_);
619	return $app;
620	}
621
622	sub pre_run_debug {
623	my $app = shift;
624	if ($MT::DebugMode & 128) {
625	print STDERR "=====START: $$===========================\n";
626	print STDERR "Package: " . ref($app) . "\n";
627	print STDERR "Session: " . $app->session->id . "\n"
628	if $app->session;
629	print STDERR "Request: " . $app->param->request_method . "\n";
630	my @param = $app->param;
631	if (@param) {
632	foreach my $key (@param) {
633	my @val = $app->param($key);
634	print STDERR "\t" . $key . ": " . $_ . "\n"
635	for @val;
636	}
637	}
638	print STDERR "-----Response:\n";
639	}
640	}
641
642	sub post_run_debug {
643	if ($MT::DebugMode & 128) {
644	print STDERR "\n=====END: $$=============================\n";
645	}
646	}
647
648	sub run_callbacks {
649	my $app = shift;
650	my ($meth, @param) = @_;
651	$meth = (ref($app)\|\|$app) . '::' . $meth unless $meth =~ m/::/;
652	return $app->SUPER::run_callbacks($meth, @param);
653	}
654
655	sub init_callbacks {
656	my $app = shift;
657	$app->SUPER::init_callbacks(@_);
658	MT->add_callback('*::post_save', 0, $app, \&_cb_mark_blog );
659	MT->add_callback('MT::Blog::post_remove', 0, $app, \&_cb_unmark_blog );
660	MT->add_callback('new_user_provisioning', 5, $app, \&_cb_user_provisioning);
661	}
662
663	sub init_request {
664	my $app = shift;
665	my %param = @_;
666
667	return if $app->{init_request};
668
669	if ($app->{request_read_config}) {
670	$app->init_config(\%param) or return;
671	$app->{request_read_config} = 0;
672	}
673
674	# @req_vars: members of the app object which are request-specific
675	# and are cleared at the beginning of each request.
676	my @req_vars = qw(mode __path_info _blog redirect login_again
677	no_print_body response_code response_content_type response_message
678	author cgi_headers breadcrumbs goback cache_templates warning_trace
679	cookies _errstr request_method requires_login );
680	delete $app->{$_} foreach @req_vars;
681	$app->{trace} = undef;
682	$app->user(undef);
683	if ($ENV{MOD_PERL}) {
684	require Apache::Request;
685	$app->{apache} = $param{ApacheObject} \|\| Apache->request;
686	$app->{query} = Apache::Request->instance($app->{apache},
687	POST_MAX => $app->config->CGIMaxUpload);
688	} else {
689	if ($param{CGIObject}) {
690	$app->{query} = $param{CGIObject};
691	require CGI;
692	$CGI::POST_MAX = $app->config->CGIMaxUpload;
693	} else {
694	if (my $path_info = $ENV{PATH_INFO}) {
695	if ($path_info =~ m/\.cgi$/) {
696	# some CGI environments (notably 'sbox') leaves PATH_INFO
697	# defined which interferes with CGI.pm determining the
698	# request url.
699	delete $ENV{PATH_INFO};
700	}
701	}
702	require CGI;
703	$CGI::POST_MAX = $app->config->CGIMaxUpload;
704	$app->{query} = CGI->new( $app->{no_read_body} ? {} : () );
705	}
706	}
707	$app->init_query();
708
709	$app->{return_args} = $app->{query}->param('return_args');
710	$app->cookies;
711
712	## Initialize the MT::Request singleton for this particular request.
713	$app->request->reset();
714	$app->request('App-Class', ref $app);
715
716	$app->run_callbacks(ref($app) . '::init_request', $app, @_);
717
718	$app->{init_request} = 1;
719	}
720
721	sub init_query {
722	my $app = shift;
723	my $q = $app->{query};
724	# CGI.pm has this terrible flaw in that if a POST is in effect,
725	# it totally ignores any query parameters.
726	if ($app->request_method eq 'POST') {
727	my $query_string;
728	if ($ENV{MOD_PERL}) {
729	$query_string = $q->r->args;
730	} else {
731	$query_string = $ENV{'QUERY_STRING'} if defined $ENV{'QUERY_STRING'};
732	$query_string \|\|= $ENV{'REDIRECT_QUERY_STRING'} if defined $ENV{'REDIRECT_QUERY_STRING'};
733	}
734	if (defined($query_string) and $query_string ne '') {
735	$q->parse_params($query_string);
736	}
737	}
738	}
739
740	sub registry {
741	my $app = shift;
742	my $ar = $app->SUPER::registry("applications", $app->id, @_);
743	my $gr = $app->SUPER::registry(@_) if @_;
744	if ($ar) {
745	MT::__merge_hash($ar, $gr);
746	return $ar;
747	}
748	return $gr;
749	}
750
751	sub _cb_unmark_blog {
752	my ($eh, $obj) = @_;
753	my $mt_req = MT->instance->request;
754	if (my $blogs_touched = $mt_req->stash('blogs_touched')) {
755	delete $blogs_touched->{$obj->id};
756	$mt_req->stash('blogs_touched', $blogs_touched);
757	}
758	}
759
760	sub _cb_mark_blog {
761	my ($eh, $obj) = @_;
762	my $obj_type = ref $obj;
763	return if ($obj_type eq 'MT::Author' \|\|
764	$obj_type eq 'MT::Log' \|\| $obj_type eq 'MT::Session' \|\|
765	(($obj_type ne 'MT::Blog') && !$obj->has_column('blog_id')));
766	my $mt_req = MT->instance->request;
767	my $blogs_touched = $mt_req->stash('blogs_touched') \|\| {};
768	if ($obj_type eq 'MT::Blog') {
769	$blogs_touched->{$obj->id} = 0;
770	} else {
771	$blogs_touched->{$obj->blog_id} = 1 if $obj->blog_id;
772	}
773	$mt_req->stash('blogs_touched', $blogs_touched);
774	}
775
776	sub _cb_user_provisioning {
777	my ($cb, $user) = @_;
778
779	# Supply user with what they need...
780
781	require MT::Blog;
782	require MT::Util;
783	my $new_blog;
784	my $blog_name = $user->nickname \|\| MT->translate("First Weblog");
785	if (my $blog_id = MT->config('NewUserTemplateBlogId')) {
786	my $blog = MT::Blog->load($blog_id);
787	if (!$blog) {
788	MT->log({
789	message => MT->translate("Error loading blog #[_1] for user provisioning. Check your NewUserTemplateBlogId setting.", $blog_id),
790	level => MT::Log::ERROR(),
791	});
792	return;
793	}
794	$new_blog = $blog->clone({
795	Children => 1,
796	Classes => { 'MT::Permission' => 0, 'MT::Association' => 0 },
797	BlogName => $blog_name,
798	});
799	if (!$new_blog) {
800	MT->log({
801	message => MT->translate("Error provisioning blog for new user '[_1]' using template blog #[_2].", $user->id, $blog->id),
802	level => MT::Log::ERROR(),
803	});
804	return;
805	}
806	} else {
807	$new_blog = MT::Blog->create_default_blog($blog_name);
808	}
809
810	my $dir_name;
811	if (my $root = MT->config('DefaultSiteRoot')) {
812	my $fmgr = $new_blog->file_mgr;
813	if (-d $root) {
814	my $path;
815	$dir_name = MT::Util::dirify($new_blog->name);
816	$dir_name = 'blog-' if ($dir_name =~ /^_*$/);
817	my $sfx = 0;
818	while (1) {
819	$path = File::Spec->catdir($root, $dir_name . ($sfx ? $sfx : ''));
820	$path =~ s/(.+)\-$/$1/;
821	if (!-d $path) {
822	$fmgr->mkpath($path);
823	if (!-d $path) {
824	MT->log({
825	message => MT->translate("Error creating directory [_1] for blog #[_2].", $path, $new_blog->id),
826	level => MT::Log::ERROR(),
827	});
828	}
829	last;
830	}
831	$sfx++;
832	}
833	$dir_name .= $sfx ? $sfx : '';
834	$dir_name =~ s/(.+)\-$/$1/;
835	$new_blog->site_path($path);
836	}
837	}
838	if (my $url = MT->config('DefaultSiteURL')) {
839	$url .= '/' unless $url =~ m!/$!;
840	$url .= $dir_name ? $dir_name : MT::Util::dirify($new_blog->name);
841	$url .= '/';
842	$new_blog->site_url($url);
843	}
844	my $offset = MT->config('DefaultTimezone');
845	if (defined $offset) {
846	$new_blog->server_offset($offset);
847	}
848	$new_blog->save
849	or MT->log({
850	message => MT->translate("Error provisioning blog for new user '[_1] (ID: [_2])'.", $user->id, $user->name),
851	level => MT::Log::ERROR(),
852	}), return;
853	MT->log({
854	message => MT->translate(
855	"Blog '[_1] (ID: [_2])' for user '[_3] (ID: [_4])' has been created.",
856	$new_blog->name, $new_blog->id, $user->name, $user->id),
857	level => MT::Log::INFO(),
858	class => 'system',
859	category => 'new'
860	});
861
862	require MT::Role;
863	require MT::Association;
864	my $role = MT::Role->load_by_permission('administer_blog');
865	if ($role) {
866	MT::Association->link($user => $role => $new_blog);
867	} else {
868	MT->log({
869	message => MT->translate(
870	"Error assigning blog administration rights to user '[_1] (ID: [_2])' for blog '[_3] (ID: [_4])'. No suitable blog administrator role was found.",
871	$user->name, $user->id, $new_blog->name, $new_blog->id,),
872	level => MT::Log::ERROR(),
873	class => 'system',
874	category => 'new'
875	});
876	}
877	1;
878	}
879
880	# Along with _cb_unmark_blog and _cb_mark_blog, this is an elaborate
881	# scheme to cause MT::Blog objects that are affected as a result of a
882	# change to a child class to be updated with respect to their
883	# 'last modification' timestamp which is used by the dynamic engine
884	# to determine when cached files are stale.
885	sub touch_blogs {
886	my $blogs_touched = MT->instance->request('blogs_touched') or return;
887	foreach my $blog_id (keys %$blogs_touched) {
888	next unless $blog_id;
889	my $blog = MT::Blog->load($blog_id);
890	next unless ( $blog );
891	if (($blog->custom_dynamic_templates \|\| '') ne 'none') {
892	$blog->touch();
893	$blog->save() or die $blog->errstr;
894	}
895	}
896	}
897
898	sub add_breadcrumb {
899	my $app = shift;
900	push @{ $app->{breadcrumbs} }, {
901	bc_name => $_[0],
902	bc_uri => $_[1],
903	}
904	}
905
906	sub is_authorized { 1 }
907
908	sub user_cookie { $COOKIE_NAME }
909
910	sub user {
911	my $app = shift;
912	$app->{author} = $app->{$COOKIE_NAME} = $_[0] if @_;
913	return $app->{author};
914	}
915
916	sub permissions {
917	my $app = shift;
918	$app->{perms} = shift if @_;
919	return $app->{perms};
920	}
921
922	sub session {
923	my $app = shift;
924	my $sess = $app->{session};
925	return unless $sess;
926	if (@_) {
927	my $setting = shift;
928	@_ ? $sess->set($setting, @_) : $sess->get($setting);
929	} else {
930	$sess;
931	}
932	}
933
934	sub make_magic_token {
935	my @alpha = ('a'..'z', 'A'..'Z', 0..9);
936	my $token = join '', map $alpha[rand @alpha], 1..40;
937	$token;
938	}
939
940	sub make_session {
941	my ($auth, $remember) = @_;
942	require MT::Session;
943	my $sess = new MT::Session;
944	$sess->id(make_magic_token());
945	$sess->kind('US'); # US == User Session
946	$sess->start(time);
947	$sess->set('author_id', $auth->id);
948	$sess->set('remember', 1) if $remember;
949	$sess->save;
950	$sess;
951	}
952
953	# given credentials in the form of a username, optional password, and
954	# session ID ("token"), this returns the corresponding author object
955	# if the credentials are legit, 0 if insufficient credentials were there,
956	# or undef if they were actually incorrect
957	sub session_user {
958	my $app = shift;
959	my ($author, $session_id, %opt) = @_;
960	return undef unless $author && $session_id;
961	if ($app->{session}) {
962	if ($app->{session}->get('author_id') == $author->id) {
963	return $author;
964	}
965	}
966
967	require MT::Session;
968	my $timeout = $opt{permanent} ? (36024365*10)
969	: $app->config->UserSessionTimeout;
970	my $sess = MT::Session::get_unexpired_value($timeout,
971	{ id => $session_id,
972	kind => 'US' });
973	$app->{session} = $sess;
974
975	return undef if !$sess;
976	if ($sess && ($sess->get('author_id') == $author->id)) {
977	return $author;
978	} else {
979	return undef;
980	}
981	}
982
983	sub _make_commenter_session {
984	my $app = shift;
985	my ($session_key, $email, $name, $nick, $id, $url, $timeout, $blog_id) = @_;
986
987	my $enc = $app->charset;
988	$nick = encode_text($nick, $enc, 'utf-8');
989	my $nick_escaped = MT::Util::escape_unicode( $nick );
990
991	$timeout = '+' . $app->{cfg}->CommentSessionTimeout . 's' unless defined $timeout;
992	my %kookee = (-name => COMMENTER_COOKIE_NAME(),
993	-value => $session_key,
994	-path => '/',
995	($timeout ? (-expires => $timeout) : ()));
996	$app->bake_cookie(%kookee);
997	my %name_kookee = (-name => "commenter_name",
998	-value => $nick_escaped,
999	-path => '/',
1000	($timeout ? (-expires => $timeout) : ()));
1001	$app->bake_cookie(%name_kookee);
1002	if (defined $id) {
1003	my @blogs;
1004	if ($app->user && $app->user->is_superuser) {
1005	@blogs = $app->model('blog')->load( undef, {
1006	fetchonly => [ 'id' ],
1007	});
1008	}
1009	else {
1010	@blogs = $app->model('blog')->load(undef,
1011	{
1012	fetchonly => [ 'id' ],
1013	join => MT::Permission->join_on('blog_id',
1014	{
1015	permissions => "\%'comment'\%",
1016	author_id => $id
1017	},
1018	{ 'like' => { 'permissions' => 1 } }
1019	)
1020	}
1021	);
1022	}
1023	my $blog_ids = @blogs ? "'" . join("','", map { $_->id } @blogs) . "'" : '';
1024
1025	my $perm = MT::Permission->load({ blog_id => $blog_id, author_id => $id });
1026	if ($perm) {
1027	# double-check to see if this user hasn't been denied commenting
1028	# permission. user has 'comment' permission through a role,
1029	# but check for a restriction to comment on this blog
1030	if ($perm->is_restricted('comment')) {
1031	$blog_ids =~ s/(,\|^)'$blog_id'(,\|$)//;
1032	}
1033
1034	# But if the permission carries a 'can administer' permission
1035	# they should be allowed
1036	if ($blog_id && ($blog_ids !~ m/(,\|^)'$blog_id'(,\|$)/)) {
1037	if ($perm->can_administer_blog()) {
1038	# user is a blog administrator, so yes, they can comment too
1039	$blog_ids .= ($blog_ids ne '' ? ',' : '')
1040	. "'" . $blog_id . "'";
1041	}
1042	}
1043	}
1044	else {
1045	if ($blog_id && ($blog_ids !~ m/(,\|^)'$blog_id'(,\|$)/)) {
1046	# extra check to see if this user can comment on requested
1047	# blog; this is specific to the Comment application, so
1048	# only do this if we're running the comments app.
1049	if ( $app->isa( 'MT::App::Comments' )) {
1050	if ( $app->_check_commenter_author($app->user, $blog_id) ) {
1051	# is this blog open to commenting from registered users?
1052	# if so, this user really can comment, even though they
1053	# don't have explicit permissions for it
1054	$blog_ids .= ($blog_ids ne '' ? ',' : '')
1055	. "'" . $blog_id . "'";
1056	}
1057	}
1058	}
1059	}
1060
1061	my %id_kookee = (-name => "commenter_id",
1062	-value => $id . ':' . $blog_ids,
1063	-path => '/',
1064	($timeout ? (-expires => $timeout) : ()));
1065	$app->bake_cookie(%id_kookee);
1066	}
1067	if (defined($url) && $url) {
1068	my %id_kookee = (-name => "commenter_url",
1069	-value => $url,
1070	-path => '/',
1071	($timeout ? (-expires => $timeout) : ()));
1072	$app->bake_cookie(%id_kookee);
1073	}
1074
1075	require MT::Session;
1076	my $sess_obj = MT::Session->new();
1077	$sess_obj->id($session_key);
1078	$sess_obj->email($email);
1079	$sess_obj->name($name);
1080	$sess_obj->start(time);
1081	$sess_obj->kind("SI");
1082	$sess_obj->save()
1083	or return $app->error($app->translate("The login could not be confirmed because of a database error ([_1])", $sess_obj->errstr));
1084	return $session_key;
1085	}
1086
1087	sub _invalidate_commenter_session {
1088	my $app = shift;
1089	my ($cookies) = @_;
1090
1091	my $cookie_val = ($cookies->{COMMENTER_COOKIE_NAME()}
1092	? $cookies->{COMMENTER_COOKIE_NAME()}->value()
1093	: "");
1094	my $session = $cookie_val;
1095	require MT::Session;
1096	my $sess_obj = MT::Session->load({id => $session });
1097	$sess_obj->remove() if ($sess_obj);
1098
1099	my $timeout = $app->{cfg}->CommentSessionTimeout;
1100
1101	my %kookee = (-name => COMMENTER_COOKIE_NAME(),
1102	-value => '',
1103	-path => '/',
1104	-expires => "+${timeout}s");
1105	$app->bake_cookie(%kookee);
1106	my %name_kookee = (-name => 'commenter_name',
1107	-value => '',
1108	-path => '/',
1109	-expires => "+${timeout}s");
1110	$app->bake_cookie(%name_kookee);
1111	my %id_kookee = (-name => 'commenter_id',
1112	-value => '',
1113	-path => '/',
1114	-expires => "+${timeout}s");
1115	$app->bake_cookie(%id_kookee);
1116	}
1117
1118	sub start_session {
1119	my $app = shift;
1120	my ($author, $remember) = @_;
1121	if (!defined $author) {
1122	$author = $app->user;
1123	my ($x, $y);
1124	($x, $y, $remember) = split(/::/, $app->cookie_val($app->user_cookie));
1125	}
1126	my $session = make_session($author, $remember);
1127	my %arg = (-name => $COOKIE_NAME,
1128	-value => join('::',
1129	$author->name,
1130	$session->id,
1131	$remember),
1132	-path => $app->config->CookiePath \|\| $app->mt_path
1133	);
1134	$arg{-expires} = '+10y' if $remember;
1135	$app->{session} = $session;
1136	$app->bake_cookie(%arg);
1137	\%arg;
1138	}
1139
1140	sub _get_options_tmpl {
1141	my $self = shift;
1142	my ($authenticator) = @_;
1143
1144	my $tmpl = $authenticator->{login_form};
1145	return q() unless $tmpl;
1146	return $tmpl->($authenticator) if ref $tmpl eq 'CODE';
1147	if ( $tmpl =~ /\s/ ) {
1148	return $tmpl;
1149	}
1150	else { # no spaces in $tmpl; must be a filename...
1151	if ( my $plugin = $authenticator->{plugin} ) {
1152	return $plugin->load_tmpl($tmpl) or die $plugin->errstr;
1153	}
1154	else {
1155	return MT->instance->load_tmpl($tmpl);
1156	}
1157	}
1158	}
1159
1160	sub _get_options_html {
1161	my $app = shift;
1162	my ($key) = @_;
1163	my $authenticator = MT->commenter_authenticator($key);
1164	return q() unless $authenticator;
1165
1166	my $snip_tmpl = $app->_get_options_tmpl($authenticator);
1167	return q() unless $snip_tmpl;
1168
1169	require MT::Template;
1170	my $tmpl;
1171	if ( ref $snip_tmpl ne 'MT::Template' ) {
1172	$tmpl = MT::Template->new(
1173	type => 'scalarref',
1174	source => ref $snip_tmpl ? $snip_tmpl : \$snip_tmpl
1175	);
1176	}
1177	else {
1178	$tmpl = $snip_tmpl;
1179	}
1180
1181	$app->set_default_tmpl_params($tmpl);
1182	if ( my $p = $authenticator->{login_form_params} ) {
1183	my $params = $p->(
1184	$key,
1185	$app->param('blog_id'),
1186	$app->param('entry_id') \|\| undef,
1187	$app->param('static') \|\| encode_url($app->param('return_to'))
1188	);
1189	$tmpl->param($params) if $params;
1190	}
1191	my $html = $tmpl->output();
1192	if ( UNIVERSAL::isa( $authenticator, 'MT::Plugin' )
1193	&& ( $html =~ m/<__trans / ) )
1194	{
1195	$html = $authenticator->translate_templatized($html);
1196	}
1197	$html;
1198	}
1199
1200	sub external_authenticators {
1201	my $app = shift;
1202	my ($blog, $param) = @_;
1203	return [] unless $blog;
1204
1205	$param \|\|= {};
1206
1207	my @external_authenticators;
1208
1209	my $ca_reg = $app->registry("commenter_authenticators");
1210
1211	my @auths = split ',', $blog->commenter_authenticators;
1212	my %otherauths;
1213	foreach my $key (@auths) {
1214	if ( $key eq 'MovableType' ) {
1215	$param->{enabled_MovableType} = 1;
1216	$param->{default_signin} = 'MovableType';
1217	my $cfg = $app->config;
1218	if ( my $registration = $cfg->CommenterRegistration ) {
1219	if ( $cfg->AuthenticationModule eq 'MT' ) {
1220	$param->{registration_allowed} = $registration->{Allow}
1221	&& $blog->allow_commenter_regist ? 1 : 0;
1222	}
1223	}
1224	require MT::Auth;
1225	$param->{can_recover_password} = MT::Auth->can_recover_password;
1226	next;
1227	}
1228	my $auth = $ca_reg->{$key};
1229	next unless $auth;
1230	if ( $key ne 'TypeKey'
1231	&& $key ne 'OpenID'
1232	&& $key ne 'Vox'
1233	&& $key ne 'LiveJournal' )
1234	{
1235	push @external_authenticators,
1236	{
1237	name => $auth->{label},
1238	key => $auth->{key},
1239	login_form => $app->_get_options_html($key),
1240	exists($auth->{logo}) ? (logo => $auth->{logo}) : (),
1241	};
1242	}
1243	else {
1244	$otherauths{$key} = {
1245	name => $auth->{label},
1246	key => $auth->{key},
1247	login_form => $app->_get_options_html($key),
1248	exists($auth->{logo}) ? (logo => $auth->{logo}) : (),
1249	};
1250	}
1251	}
1252
1253	unshift @external_authenticators, $otherauths{'TypeKey'}
1254	if exists $otherauths{'TypeKey'};
1255	unshift @external_authenticators, $otherauths{'Vox'}
1256	if exists $otherauths{'Vox'};
1257	unshift @external_authenticators, $otherauths{'LiveJournal'}
1258	if exists $otherauths{'LiveJournal'};
1259	unshift @external_authenticators, $otherauths{'OpenID'}
1260	if exists $otherauths{'OpenID'};
1261
1262	\@external_authenticators;
1263	}
1264
1265	sub _is_commenter {
1266	my $app = shift;
1267	my ($author) = @_;
1268
1269	# Check if the user is a commenter and keep them from logging in to the app
1270	my @author_perms = $app->model('permission')->load(
1271	{ author_id => $author->id, blog_id => '0' },
1272	{ not => { blog_id => 1 } });
1273	my $commenter = -1;
1274	my $commenter_blog_id;
1275	for my $perm (@author_perms) {
1276	my $permissions = $perm->permissions;
1277	next unless $permissions;
1278	if ( $permissions eq "'comment'" ) {
1279	$commenter_blog_id = $perm->blog_id unless $commenter_blog_id;
1280	$commenter = 1;
1281	next;
1282	}
1283	return 0;
1284	}
1285	if ( -1 == $commenter ) {
1286	# this user does not have any permission to any blog
1287	# check for system permission
1288	my $sys_perms = MT::Permission->perms('system');
1289	my $has_system_permission = 0;
1290	foreach (@$sys_perms) {
1291	if ( $author->permissions(0)->has( $_->[0] ) ) {
1292	$has_system_permission = 1;
1293	last;
1294	}
1295	}
1296	return $app->error($app->translate('Our apologies, but you do not have permission to access any blogs within this installation. If you feel you have reached this message in error, please contact your Movable Type system administrator.'))
1297	unless $has_system_permission;
1298	return -1;
1299	}
1300	return $commenter_blog_id;
1301	}
1302
1303	# virutal method overridden when pending user has special treatment
1304	sub login_pending { q() }
1305
1306	# virutal method overridden when commenter needs special treatment
1307	sub commenter_loggedin {
1308	my $app = shift;
1309	my ($commenter, $commenter_blog_id) = @_;
1310	my $blog = $app->model('blog')->load($commenter_blog_id);
1311	my $url = $app->config('CGIPath') . $app->config('CommentScript');
1312	$url .= '?__mode=edit_profile';
1313	$url .= '&commenter=' . $commenter->id;
1314	$url .= '&blog_id=' . $commenter_blog_id;
1315	$url .= '&static=' . $blog->site_url;
1316	$url;
1317	}
1318
1319	# MT::App::login
1320	# Working from the query object, determine whether the session is logged in,
1321	# perform any session/cookie maintenance, and if we're logged in,
1322	# return a pair
1323	# ($author, $first_time)
1324	# where $author is an author object and $first_time is true if this
1325	# is the first request of a session. $first_time is returned just
1326	# for any plugins that might need it, since historically the logging
1327	# and session management was done by the calling code.
1328
1329	sub login {
1330	my $app = shift;
1331
1332	my $new_login = 0;
1333
1334	require MT::Auth;
1335	my $ctx = MT::Auth->fetch_credentials({ app => $app });
1336	unless ($ctx) {
1337	if ( $app->param('submit') ) {
1338	return $app->error($app->translate('Invalid login.'));
1339	}
1340	return;
1341	}
1342
1343	my $res = MT::Auth->validate_credentials($ctx) \|\| MT::Auth::UNKNOWN();
1344	my $user = $ctx->{username};
1345
1346	if ($res == MT::Auth::UNKNOWN()) {
1347	# Login invalid; auth layer knows nothing of user
1348	$app->log({
1349	message => $app->translate("Failed login attempt by unknown user '[_1]'", $user),
1350	level => MT::Log::WARNING(),
1351	category => 'login_user',
1352	}) if defined $user;
1353	MT::Auth->invalidate_credentials({app => $app});
1354	return $app->error($app->translate('Invalid login.'));
1355	} elsif ($res == MT::Auth::INACTIVE()) {
1356	# Login invalid; auth layer reports user was disabled
1357	$app->log({
1358	message => $app->translate("Failed login attempt by disabled user '[_1]'", $user),
1359	level => MT::Log::WARNING(),
1360	category => 'login_user',
1361	});
1362	return $app->error($app->translate(
1363	'This account has been disabled. Please see your system administrator for access.'));
1364	} elsif ($res == MT::Auth::PENDING()) {
1365	# Login invalid; auth layer reports user was pending
1366	# Check if registration is allowed and if so send special message
1367	my $message;
1368	if ( my $registration = $app->config->CommenterRegistration ) {
1369	if ( $registration->{Allow} ) {
1370	$message = $app->login_pending();
1371	}
1372	}
1373	$message \|\|= $app->translate(
1374	'This account has been disabled. Please see your system administrator for access.');
1375	$app->user(undef);
1376	$app->log({
1377	message => $app->translate("Failed login attempt by pending user '[_1]'", $user),
1378	level => MT::Log::WARNING(),
1379	category => 'login_user',
1380	});
1381	return $app->error($message);
1382	} elsif ($res == MT::Auth::INVALID_PASSWORD()) {
1383	# Login invlaid (password error, etc...)
1384	return $app->error($app->translate('Invalid login.'));
1385	} elsif ($res == MT::Auth::DELETED()) {
1386	# Login invalid; auth layer says user record has been removed
1387	return $app->error($app->translate(
1388	'This account has been deleted. Please see your system administrator for access.'));
1389	} elsif ($res == MT::Auth::REDIRECT_NEEDED()) {
1390	# The authentication driver is delegating authentication to another URL, follow the
1391	# designated redirect.
1392	my $url = $app->config->AuthLoginURL;
1393	if ($url && !$app->{redirect}) {
1394	$app->redirect($url);
1395	}
1396	return 0; # Return undefined so the redirect (set by the Auth Driver) will be
1397	# followed by MT.
1398	} elsif ($res == MT::Auth::NEW_LOGIN()) {
1399	# auth layer reports valid user and that this is a new login. act accordingly
1400	my $author = $app->user;
1401	MT::Auth->new_login($app, $author);
1402	$new_login = 1;
1403	} elsif ($res == MT::Auth::NEW_USER()) {
1404	# auth layer reports that a new user has been created by logging in.
1405	my $user_class = $app->user_class;
1406	my $author = $user_class->new;
1407	$app->user($author);
1408	$author->name($ctx->{username}) if $ctx->{username};
1409	$author->type(MT::Author::AUTHOR());
1410	$author->status(MT::Author::ACTIVE());
1411	$author->auth_type($app->config->AuthenticationModule);
1412	my $saved = MT::Auth->new_user($app, $author);
1413	$saved = $author->save unless $saved;
1414
1415	unless ($saved) {
1416	$app->log({
1417	message => MT->translate("User cannot be created: [_1].", $author->errstr),
1418	level => MT::Log::ERROR(),
1419	class => 'system',
1420	category => 'create_user'
1421	}), $app->error(MT->translate("User cannot be created: [_1].", $author->errstr)), return undef;
1422	}
1423
1424	$app->log({
1425	message => MT->translate("User '[_1]' has been created.", $author->name),
1426	level => MT::Log::INFO(),
1427	class => 'system',
1428	category => 'create_user'
1429	});
1430
1431	# provision user if configured to do so
1432	if ($app->config->NewUserAutoProvisioning) {
1433	MT->run_callbacks('new_user_provisioning', $author);
1434	}
1435	$new_login = 1;
1436	}
1437	my $author = $app->user;
1438
1439	# At this point the MT::Auth module should have initialized an author object. If
1440	# it did then everything is cool and the MT session is initialized. If not, then
1441	# an error is thrown
1442
1443	if ($author) {
1444	# Login valid
1445	if ($new_login) {
1446
1447	my $commenter_blog_id = $app->_is_commenter($author);
1448	return unless defined $commenter_blog_id;
1449	# $commenter_blog_id
1450	# 0: user has more permissions than comment
1451	# N: user has only comment permission on some blog
1452	# -1: user has only system permissions
1453	# undef: user does not have any permission
1454
1455	if ( $commenter_blog_id >= 0 ) {
1456	# Presence of 'password' indicates this is a login request;
1457	# do session/cookie management.
1458	$app->_make_commenter_session(
1459	$app->make_magic_token,
1460	$author->email,
1461	$author->name,
1462	($author->nickname \|\| $app->translate('(Display Name not set)')),
1463	$author->id,
1464	undef,
1465	$ctx->{permanent} ? '+10y' : 0
1466	);
1467
1468	if ($commenter_blog_id) {
1469	my $url = $app->commenter_loggedin($author, $commenter_blog_id);
1470	return $app->redirect($url);
1471	}
1472	}
1473	## commenter_blog_id can be -1 - user who has only system permissions
1474
1475	$app->start_session($author, $ctx->{permanent} ? 1 : 0);
1476	$app->request('fresh_login', 1);
1477	$app->log($app->translate("User '[_1]' (ID:[_2]) logged in successfully", $author->name, $author->id));
1478	} else {
1479	$author = $app->session_user($author, $ctx->{session_id}, permanent => $ctx->{permanent});
1480	if (!defined($author)) {
1481	$app->user(undef);
1482	$app->{login_again} = 1;
1483	return undef;
1484	}
1485	}
1486
1487	# $author->last_login();
1488	# $author->save;
1489
1490	## update session so the user will be counted as active
1491	require MT::Session;
1492	my $sess_active = MT::Session->load( { kind => 'UA', name => $author->id } );
1493	if (!$sess_active) {
1494	$sess_active = MT::Session->new;
1495	$sess_active->id(make_magic_token());
1496	$sess_active->kind('UA'); # UA == User Activation
1497	$sess_active->name($author->id);
1498	}
1499	$sess_active->start(time);
1500	$sess_active->save;
1501
1502	return ($author, $new_login);
1503	} else {
1504	MT::Auth->invalidate_credentials({app => $app});
1505	if (!defined($author)) {
1506	require MT::Log;
1507	# undef indicates invalid login as opposed to no login at all.
1508	$app->log({
1509	message => $app->translate("Invalid login attempt from user '[_1]'", $user),
1510	level => MT::Log::WARNING(),
1511	});
1512	return $app->error($app->translate('Invalid login.'));
1513	} else {
1514	return undef;
1515	}
1516	}
1517	}
1518
1519	sub logout {
1520	my $app = shift;
1521
1522	require MT::Auth;
1523
1524	my $ctx = MT::Auth->fetch_credentials({ app => $app });
1525	if ($ctx && $ctx->{username}) {
1526	my $user_class = $app->user_class;
1527	my $user = $user_class->load({ name => $ctx->{username}, type => MT::Author::AUTHOR() });
1528	if ($user) {
1529	$app->user($user);
1530	$app->log($app->translate("User '[_1]' (ID:[_2]) logged out",
1531	$user->name, $user->id));
1532	}
1533	}
1534
1535	MT::Auth->invalidate_credentials({ app => $app });
1536	my %cookies = $app->cookies();
1537	$app->_invalidate_commenter_session(\%cookies);
1538
1539	# The login box should only be displayed in the event of non-delegated auth
1540	# right?
1541	my $delegate = MT::Auth->delegate_auth();
1542	if ($delegate) {
1543	my $url = $app->config->AuthLogoutURL;
1544	if ($url && !$app->{redirect}) {
1545	$app->redirect($url);
1546	}
1547	if ($app->{redirect}) {
1548	# Return 0 to force MT to follow redirects
1549	return 0;
1550	}
1551	}
1552
1553	# Displaying the login box
1554	$app->load_tmpl('login.tmpl', {
1555	logged_out => 1,
1556	no_breadcrumbs => 1,
1557	login_fields => MT::Auth->login_form($app),
1558	can_recover_password => MT::Auth->can_recover_password,
1559	delegate_auth => $delegate,
1560	});
1561	}
1562
1563	sub create_user_pending {
1564	my $app = shift;
1565	my $q = $app->param;
1566	my ($param) = @_;
1567	$param \|\|= {};
1568
1569	my $cfg = $app->config;
1570	$param->{ 'auth_mode_' . $cfg->AuthenticationModule } = 1;
1571
1572	my $blog = $app->model('blog')->load( $param->{blog_id} );
1573
1574	my ( $password, $hint, $url );
1575	unless ( $q->param('external_auth') ) {
1576	$password = $q->param('password');
1577	unless ($password) {
1578	return $app->error($app->translate("User requires password."));
1579	}
1580
1581	if ( $q->param('password') ne $q->param('pass_verify') ) {
1582	return $app->error($app->translate('Passwords do not match.'));
1583	}
1584
1585	$hint = $q->param('hint');
1586	unless ($hint) {
1587	return $app->error($app->translate("User requires password recovery word/phrase."));
1588	}
1589
1590	$url = $q->param('url');
1591	if ( $url && !is_url($url) ) {
1592	return $app->error($app->translate("URL is invalid."));
1593	}
1594	}
1595
1596	my $name = $q->param('username');
1597	if ( defined $name ) {
1598	$name =~ s/(^\s+\|\s+$)//g;
1599	$param->{name} = $name;
1600	}
1601	unless ( defined($name) && $name ) {
1602	return $app->error($app->translate("User requires username."));
1603	}
1604
1605	my $existing = MT::Author->count( { name => $name } );
1606	return $app->error($app->translate("A user with the same name already exists."))
1607	if $existing;
1608
1609	my $nickname = $q->param('nickname');
1610	unless ($nickname) {
1611	return $app->error($app->translate("User requires display name."));
1612	}
1613
1614	my $email = $q->param('email');
1615	if ($email) {
1616	unless ( is_valid_email($email) ) {
1617	delete $param->{email};
1618	return $app->error($app->translate("Email Address is invalid."));
1619	}
1620	}
1621	else {
1622	delete $param->{email};
1623	return $app->error($app->translate("Email Address is required for password recovery."));
1624	}
1625
1626	if ( my $provider = MT->effective_captcha_provider( $blog->captcha_provider ) ) {
1627	unless ( $provider->validate_captcha($app) ) {
1628	return $app->error($app->translate("Text entered was wrong. Try again."));
1629	}
1630	}
1631
1632	my $user = $app->model('author')->new;
1633	$user->name($name);
1634	$user->nickname($nickname);
1635	$user->email($email);
1636	unless ( $q->param('external_auth') ) {
1637	$user->set_password( $q->param('password') );
1638	$user->url($url) if $url;
1639	$user->hint($hint) if $hint;
1640	}
1641	else {
1642	$user->password( '(none)' );
1643	}
1644	$user->type( MT::Author::AUTHOR() );
1645	$user->status( MT::Author::PENDING() );
1646	$user->auth_type( $app->config->AuthenticationModule );
1647
1648	unless ( $user->save ) {
1649	return $app->error($app->translate(
1650	"Something wrong happened when trying to process signup: [_1]",
1651	$user->errstr ));
1652	}
1653	return $user;
1654
1655	}
1656
1657	sub _send_comment_notification {
1658	my $app = shift;
1659	my ( $comment, $comment_link, $entry, $blog, $commenter ) = @_;
1660
1661	return unless $blog->email_new_comments;
1662
1663	my $cfg = $app->config;
1664	my $attn_reqd = $comment->is_moderated;
1665
1666	if ( $blog->email_attn_reqd_comments && !$attn_reqd ) {
1667	return;
1668	}
1669
1670	require MT::Mail;
1671	my $author = $entry->author;
1672	$app->set_language( $author->preferred_language )
1673	if $author && $author->preferred_language;
1674	my $from_addr;
1675	my $reply_to;
1676	if ( $cfg->EmailReplyTo ) {
1677	$reply_to = $comment->email;
1678	}
1679	else {
1680	$from_addr = $comment->email;
1681	}
1682	$from_addr = undef if $from_addr && !is_valid_email($from_addr);
1683	$reply_to = undef if $reply_to && !is_valid_email($reply_to);
1684	if ( $author && $author->email ) { # } && is_valid_email($author->email)) {
1685	if ( !$from_addr ) {
1686	$from_addr = $cfg->EmailAddressMain \|\| $author->email;
1687	$from_addr = $comment->author . ' <' . $from_addr . '>'
1688	if $comment->author;
1689	}
1690	my %head = (
1691	id => 'new_comment',
1692	To => $author->email,
1693	$from_addr ? ( From => $from_addr ) : (),
1694	$reply_to ? ( 'Reply-To' => $reply_to ) : (),
1695	Subject => '['
1696	. $blog->name . '] '
1697	. $app->translate( "New Comment Added to '[_1]'", $entry->title )
1698	);
1699	my $charset = $cfg->MailEncoding \|\| $cfg->PublishCharset;
1700	$head{'Content-Type'} = qq(text/plain; charset="$charset");
1701	my $base;
1702	{
1703	local $app->{is_admin} = 1;
1704	$base = $app->base . $app->mt_uri;
1705	}
1706	if ( $base =~ m!^/! ) {
1707	my ($blog_domain) = $blog->site_url =~ m\|(.+://[^/]+)\|;
1708	$base = $blog_domain . $base;
1709	}
1710	my $nonce =
1711	MT::Util::perl_sha1_digest_hex( $comment->id
1712	. $comment->created_on
1713	. $blog->id
1714	. $cfg->SecretToken );
1715	my $approve_link = $base
1716	. $app->uri_params(
1717	'mode' => 'approve_item',
1718	args => {
1719	blog_id => $blog->id,
1720	'_type' => 'comment',
1721	id => $comment->id,
1722	nonce => $nonce
1723	}
1724	);
1725	my $spam_link = $base
1726	. $app->uri_params(
1727	'mode' => 'handle_junk',
1728	args => {
1729	blog_id => $blog->id,
1730	'_type' => 'comment',
1731	id => $comment->id,
1732	nonce => $nonce
1733	}
1734	);
1735	my $edit_link = $base
1736	. $app->uri_params(
1737	'mode' => 'view',
1738	args => {
1739	blog_id => $blog->id,
1740	'_type' => 'comment',
1741	id => $comment->id
1742	}
1743	);
1744	my $ban_link = $base
1745	. $app->uri_params(
1746	'mode' => 'save',
1747	args => {
1748	'_type' => 'banlist',
1749	blog_id => $blog->id,
1750	ip => $comment->ip
1751	}
1752	);
1753	my %param = (
1754	blog => $blog,
1755	entry => $entry,
1756	view_url => $comment_link,
1757	approve_url => $approve_link,
1758	spam_url => $spam_link,
1759	edit_url => $edit_link,
1760	ban_url => $ban_link,
1761	comment => $comment,
1762	unapproved => !$comment->visible(),
1763	state_editable => ( $author->is_superuser()
1764	\|\| ( $author->permissions($blog->id)->can_manage_feedback
1765	\|\| $author->permissions($blog->id)->can_publish_post )
1766	) ? 1 : 0,
1767	);
1768	my $body = MT->build_email( 'new-comment.tmpl', \%param );
1769	MT::Mail->send( \%head, $body )
1770	or return $app->error( MT::Mail->errstr() );
1771	}
1772	}
1773
1774	sub _send_sysadmins_email {
1775	my $app = shift;
1776	my ( $ids, $email_id, $body, $subject, $from ) = @_;
1777	my $cfg = $app->config;
1778
1779	my @ids = split ',', $ids;
1780	my @sysadmins = MT::Author->load(
1781	{
1782	id => \@ids,
1783	type => MT::Author::AUTHOR()
1784	},
1785	{
1786	join => MT::Permission->join_on(
1787	'author_id',
1788	{
1789	permissions => "\%'administer'\%",
1790	blog_id => '0',
1791	},
1792	{ 'like' => { 'permissions' => 1 } }
1793	)
1794	}
1795	);
1796
1797	require MT::Mail;
1798
1799	my $from_addr;
1800	my $reply_to;
1801	if ( $cfg->EmailReplyTo ) {
1802	$reply_to = $cfg->EmailAddressMain \|\| $from;
1803	}
1804	else {
1805	$from_addr = $cfg->EmailAddressMain \|\| $from;
1806	}
1807	$from_addr = undef if $from_addr && !is_valid_email($from_addr);
1808	$reply_to = undef if $reply_to && !is_valid_email($reply_to);
1809
1810	unless ( $from_addr \|\| $reply_to ) {
1811	$app->log(
1812	{
1813	message =>
1814	MT->translate("System Email Address is not configured."),
1815	level => MT::Log::ERROR(),
1816	class => 'system',
1817	category => 'email'
1818	}
1819	);
1820	return;
1821	}
1822
1823	foreach my $a (@sysadmins) {
1824	next unless $a->email && is_valid_email( $a->email );
1825	my %head = (
1826	id => $email_id,
1827	To => $a->email,
1828	$from_addr ? ( From => $from_addr ) : (),
1829	$reply_to ? ( 'Reply-To' => $reply_to ) : (),
1830	Subject => $subject,
1831	);
1832	my $charset = $cfg->MailEncoding \|\| $cfg->PublishCharset;
1833	$head{'Content-Type'} = qq(text/plain; charset="$charset");
1834	MT::Mail->send( \%head, $body );
1835	}
1836	}
1837
1838	sub clear_login_cookie {
1839	my $app = shift;
1840	$app->bake_cookie(-name => $COOKIE_NAME, -value => '', -expires => '-1y',
1841	-path => $app->config->CookiePath \|\| $app->mt_path);
1842	}
1843
1844	sub request_content {
1845	my $app = shift;
1846	unless (exists $app->{request_content}) {
1847	if ($ENV{MOD_PERL}) {
1848	## Read from $app->{apache}
1849	my $r = $app->{apache};
1850	my $len = $app->get_header('Content-length');
1851	$r->read($app->{request_content}, $len);
1852	} else {
1853	## Read from STDIN
1854	my $len = $ENV{CONTENT_LENGTH} \|\| 0;
1855	read STDIN, $app->{request_content}, $len;
1856	}
1857	}
1858	$app->{request_content};
1859	}
1860
1861	sub get_header {
1862	my $app = shift;
1863	my($key) = @_;
1864	if ($ENV{MOD_PERL}) {
1865	return $app->{apache}->header_in($key);
1866	} else {
1867	($key = uc($key)) =~ tr/-/_/;
1868	return $ENV{'HTTP_' . $key};
1869	}
1870	}
1871
1872	sub set_header {
1873	my $app = shift;
1874	my($key, $val) = @_;
1875	if ($ENV{MOD_PERL}) {
1876	$app->{apache}->header_out($key, $val);
1877	} else {
1878	unless ($key =~ /^-/) {
1879	($key = lc($key)) =~ tr/-/_/;
1880	$key = '-' . $key;
1881	}
1882	if ($key eq '-cookie') {
1883	push @{$app->{cgi_headers}{$key}}, $val;
1884	} else {
1885	$app->{cgi_headers}{$key} = $val;
1886	}
1887	}
1888	}
1889
1890	sub request_method {
1891	my $app = shift;
1892	if (@_) {
1893	$app->{request_method} = shift;
1894	} elsif (!exists $app->{request_method}) {
1895	if ($ENV{MOD_PERL}) {
1896	$app->{request_method} = Apache->request->method;
1897	} else {
1898	$app->{request_method} = $ENV{REQUEST_METHOD} \|\| '';
1899	}
1900	}
1901	$app->{request_method};
1902	}
1903
1904	sub upload_info {
1905	my $app = shift;
1906	my ($param_name) = @_;
1907	my $q = $app->param;
1908
1909	my ($fh, $info, $no_upload);
1910	if ($ENV{MOD_PERL}) {
1911	if (my $up = $q->upload($param_name)) {
1912	$fh = $up->fh;
1913	$info = $up->info;
1914	$no_upload = !$up->size;
1915	}
1916	else {
1917	$no_upload = 1;
1918	}
1919	}
1920	else {
1921	## Older versions of CGI.pm didn't have an 'upload' method.
1922	eval { $fh = $q->upload($param_name) };
1923	if ( $@ && $@ =~ /^Undefined subroutine/ ) {
1924	$fh = $q->param($param_name);
1925	}
1926	$no_upload = !$fh;
1927	$info = $q->uploadInfo($fh);
1928	}
1929
1930	return if $no_upload;
1931	return ($fh, $info);
1932	}
1933
1934	sub cookie_val {
1935	my $app = shift;
1936	my $cookies = $app->cookies;
1937	if ($cookies && $cookies->{$_[0]}) {
1938	return $cookies->{$_[0]}->value() \|\| "";
1939	}
1940	return "";
1941	}
1942
1943	sub bake_cookie {
1944	my $app = shift;
1945	my %param = @_;
1946	my $cfg = $app->config;
1947	if ((!exists $param{'-secure'}) && $app->is_secure) {
1948	$param{'-secure'} = 1;
1949	}
1950	unless ($param{-path}) {
1951	$param{-path} = $cfg->CookiePath \|\| $app->path;
1952	}
1953	if (!$param{-domain} && $cfg->CookieDomain) {
1954	$param{-domain} = $cfg->CookieDomain;
1955	}
1956	if ($ENV{MOD_PERL}) {
1957	require Apache::Cookie;
1958	my $cookie = Apache::Cookie->new($app->{apache}, %param);
1959	if ($param{-expires} && ($cookie->expires =~ m/%/)) {
1960	# Fix for oddball Apache::Cookie error reported on Windows.
1961	require CGI::Util;
1962	$cookie->expires(CGI::Util::expires($param{-expires}, 'cookie'));
1963	}
1964	$cookie->bake;
1965	} else {
1966	require CGI::Cookie;
1967	my $cookie = CGI::Cookie->new(%param);
1968	$app->set_header('-cookie', $cookie);
1969	}
1970	}
1971
1972	sub cookies {
1973	my $app = shift;
1974	unless ($app->{cookies}) {
1975	my $class = $ENV{MOD_PERL} ? 'Apache::Cookie' : 'CGI::Cookie';
1976	eval "use $class;";
1977	$app->{cookies} = $class->fetch;
1978	}
1979	return wantarray ? %{ $app->{cookies} } : $app->{cookies}
1980	if $app->{cookies};
1981	}
1982
1983	sub show_error {
1984	my $app = shift;
1985	my ($param) = @_;
1986	my $tmpl;
1987	my $mode = $app->mode;
1988	my $url = $app->uri;
1989	my $blog_id = $app->param('blog_id');
1990	if (ref $param ne 'HASH') {
1991	# old scalar signature
1992	$param = { error => $param };
1993	}
1994
1995	if ($MT::DebugMode && $@) {
1996	$param->{error} = '<pre>' . encode_html( $param->{error} ) . '</pre>';
1997	} else {
1998	$param->{error} = encode_html( $param->{error} );
1999	$param->{error} =~ s!(https?://\S+)!<a href="$1" target="_blank">$1</a>!g;
2000	}
2001	$tmpl = $app->load_tmpl('error.tmpl') or
2002	return "Can't load error template; got error '" . $app->errstr .
2003	"'. Giving up. Original error was <pre>$param->{error}</pre>";
2004	my $type = $app->param('__type') \|\| '';
2005	if ($type eq 'dialog') {
2006	$param->{name} \|\|= $app->{name} \|\| 'dialog';
2007	$param->{goback} \|\|= $app->{goback} \|\| 'closeDialog()';
2008	$param->{value} \|\|= $app->{value} \|\| $app->translate("Close");
2009	$param->{dialog} = 1;
2010	} else {
2011	$param->{goback} \|\|= $app->{goback} \|\| 'history.back()';
2012	$param->{value} \|\|= $app->{value} \|\| $app->translate("Go Back");
2013	}
2014	$tmpl->param( $param );
2015	$app->l10n_filter($tmpl->output);
2016	}
2017
2018	sub pre_run {
2019	my $app = shift;
2020	if (my $auth = $app->user) {
2021	if (my $lang = $app->param('__lang')) {
2022	$app->set_language($lang);
2023	} else {
2024	$app->set_language($auth->preferred_language)
2025	if $auth->has_column('preferred_language');
2026	}
2027	}
2028
2029	# allow language override
2030	my $lang = $app->session ? $app->session('lang') : '';
2031	$app->set_language( $lang ) if( $lang );
2032	if( $lang = $app->{query}->param('__lang') ) {
2033	$app->set_language( $lang );
2034	if( $app->session ) {
2035	$app->session( 'lang', $lang );
2036	$app->session->save;
2037	}
2038	}
2039
2040	$app->{breadcrumbs} = [];
2041	MT->run_callbacks((ref $app) . '::pre_run', $app);
2042	1;
2043	}
2044
2045	sub post_run { MT->run_callbacks((ref $_[0]) . '::post_run', $_[0]); 1 }
2046
2047	sub run {
2048	my $app = shift;
2049	my $q = $app->param;
2050
2051	my $timer;
2052	if ($app->config->PerformanceLogging) {
2053	$timer = $app->get_timer();
2054	$timer->pause_partial();
2055	}
2056
2057	my($body);
2058	eval {
2059	# line __LINE__ __FILE__
2060	require MT::Auth;
2061	if ($ENV{MOD_PERL}) {
2062	unless ($app->{no_read_body}) {
2063	my $status = $q->parse;
2064	unless ($status == Apache::Constants::OK()) {
2065	die $app->translate('The file you uploaded is too large.') .
2066	"\n<!--$status-->";
2067	}
2068	}
2069	} else {
2070	my $err;
2071	eval { $err = $q->cgi_error };
2072	unless ($@) {
2073	if ($err && $err =~ /^413/) {
2074	die $app->translate('The file you uploaded is too large.') .
2075	"\n";
2076	}
2077	}
2078	}
2079
2080	my $mode = $app->mode \|\| 'default';
2081
2082	REQUEST:
2083	{
2084	my $requires_login = $app->{requires_login};
2085
2086	my $code = $app->handlers_for_mode($mode);
2087
2088	my @handlers = ref($code) eq 'ARRAY' ? @$code : ( $code )
2089	if defined $code;
2090
2091	foreach my $code (@handlers) {
2092	if (ref $code eq 'HASH') {
2093	my $meth_info = $code;
2094	$requires_login = $requires_login & $meth_info->{requires_login}
2095	if exists $meth_info->{requires_login};
2096	}
2097	}
2098
2099	if ($requires_login) {
2100	my ($author) = $app->login;
2101	if (!$author \|\| !$app->is_authorized) {
2102	$body = ref ($author) eq $app->user_class
2103	? $app->show_error( { error => $app->errstr } )
2104	: $app->build_page('login.tmpl',{
2105	error => $app->errstr,
2106	no_breadcrumbs => 1,
2107	login_fields => sub { MT::Auth->login_form($app) },
2108	can_recover_password => sub { MT::Auth->can_recover_password },
2109	delegate_auth => sub { MT::Auth->delegate_auth },
2110	});
2111	last REQUEST;
2112	}
2113	}
2114
2115	unless (@handlers) {
2116	my $meth = "mode_$mode";
2117	if ($app->can($meth)) {
2118	no strict 'refs';
2119	$code = \&{ *{ ref($app).'::'.$meth } };
2120	push @handlers, $code;
2121	}
2122	}
2123
2124	if (!@handlers) {
2125	$app->error($app->translate('Unknown action [_1]', $mode));
2126	last REQUEST;
2127	}
2128
2129	$app->response_content(undef);
2130	$app->{forward} = undef;
2131
2132	$app->pre_run;
2133
2134	foreach my $code (@handlers) {
2135
2136	if (ref $code eq 'HASH') {
2137	my $meth_info = $code;
2138	$code = $meth_info->{code} \|\| $meth_info->{handler};
2139
2140	if (my $set = $meth_info->{permission}) {
2141	my $user = $app->user;
2142	my $perms = $app->permissions;
2143	my $blog = $app->blog;
2144	my $allowed = 0;
2145	if ($user) {
2146	my $admin = $user->is_superuser()
2147	\|\| ($blog && $perms && $perms->can_administer_blog());
2148	my @p = split /,/, $set;
2149	foreach my $p (@p) {
2150	my $perm = 'can_' . $p;
2151	$allowed = 1, last
2152	if $admin \|\| $perms && ($perms->can($perm) && $perms->$perm());
2153	}
2154	}
2155	unless ($allowed) {
2156	$app->errtrans("Permission denied.");
2157	last REQUEST;
2158	}
2159	}
2160	}
2161
2162	if (ref $code ne 'CODE') {
2163	$code = $app->handler_to_coderef($code);
2164	}
2165
2166	if ($code) {
2167	my @forward_params = @{ $app->{forward_params} }
2168	if $app->{forward_params};
2169	$app->{forward_params} = undef;
2170	my $content = $code->($app, @forward_params);
2171	$app->response_content($content)
2172	if defined $content;
2173	}
2174	}
2175
2176	$app->post_run;
2177
2178	if (my $new_mode = $app->{forward}) {
2179	$mode = $new_mode;
2180	goto REQUEST;
2181	}
2182
2183	$body = $app->response_content();
2184
2185	if (ref($body) && ($body->isa('MT::Template'))) {
2186	my $out = $app->build_page($body)
2187	or die $body->errstr;
2188	$body = $out;
2189	}
2190
2191	# Some browsers throw you to quirks mode if the doctype isn't
2192	# up front.
2193	$body =~ s/^\s+(<!DOCTYPE)/$1/s if defined $body;
2194
2195	unless (defined $body \|\| $app->{redirect} \|\| $app->{login_again} \|\| $app->{no_print_body}) {
2196	$body = $app->show_error( { error => $app->errstr } );
2197	}
2198	$app->error(undef);
2199	} ## end REQUEST block
2200	};
2201
2202	if ((!defined $body) && $app->{login_again}) {
2203	# login again!
2204	require MT::Auth;
2205	$body = $app->build_page('login.tmpl', {
2206	error => $app->errstr,
2207	no_breadcrumbs => 1,
2208	login_fields => MT::Auth->login_form($app),
2209	can_recover_password => MT::Auth->can_recover_password,
2210	delegate_auth => MT::Auth->delegate_auth,
2211	})
2212	or $body = $app->show_error( { error => $app->errstr } );
2213	} elsif (!defined $body) {
2214	my $err = $app->errstr \|\| $@;
2215	$body = $app->show_error( { error => $err } );
2216	}
2217
2218	if (ref($body) && ($body->isa('MT::Template'))) {
2219	$body = $@ \|\| $app->errstr;
2220	}
2221
2222	if (my $url = $app->{redirect}) {
2223	if ($app->{redirect_use_meta}) {
2224	$app->send_http_header();
2225	$app->print('<meta http-equiv="refresh" content="0;url=' .
2226	$app->{redirect} . '">');
2227	} else {
2228	if ($ENV{MOD_PERL}) {
2229	$app->{apache}->header_out(Location => $url);
2230	$app->response_code(Apache::Constants::REDIRECT());
2231	$app->send_http_header;
2232	} else {
2233	$app->print($q->redirect(-uri => $url, %{ $app->{cgi_headers} }));
2234	}
2235	}
2236	} else {
2237	unless ($app->{no_print_body}) {
2238	$app->send_http_header;
2239	if ($MT::DebugMode && !($MT::DebugMode & 128)) { # no need to emit twice
2240	if ($body =~ m!</body>!i) {
2241	if ($app->{trace} &&
2242	(!defined $app->{warning_trace} \|\| $app->{warning_trace})) {
2243	my $trace = '';
2244	foreach (@{$app->{trace}}) {
2245	my $msg = encode_html($_);
2246	$trace .= '<li>' . $msg . '</li>';
2247	}
2248	$trace = '<ul>' . $trace . '</ul>';
2249	my $panel = "<div class=\"debug-panel\">"
2250	. "<h3>" . $app->translate("Warnings and Log Messages") . "</h3>"
2251	. "<div class=\"debug-panel-inner\">"
2252	. $trace . "</div></div>";
2253	$body =~ s!(</body>)!$panel$1!i;
2254	}
2255	}
2256	}
2257	$app->print($body);
2258	}
2259	}
2260
2261	if ($timer) {
2262	$timer->mark(ref($app) . '::run');
2263	}
2264
2265	$app->takedown();
2266	}
2267
2268	sub forward {
2269	my $app = shift;
2270	my ($new_mode, @params) = @_;
2271	$app->{forward} = $new_mode;
2272	$app->{forward_params} = \@params;
2273	return undef;
2274	}
2275
2276	sub handlers_for_mode {
2277	my $app = shift;
2278	my ($mode) = @_;
2279
2280	my $code;
2281
2282	if (my $meths = $Global_actions{ref($app)}
2283	\|\| $Global_actions{$app->id}) {
2284	$code = $meths->{$mode} if exists $meths->{$mode};
2285	}
2286
2287	$code \|\|= $app->{vtbl}{$mode};
2288
2289	return $code;
2290	}
2291
2292	sub mode {
2293	my $app = shift;
2294	if (@_) {
2295	$app->{mode} = shift;
2296	} else {
2297	if (my $mode = $app->param('__mode')) {
2298	$mode =~ s/[<>"']//g;
2299	$app->{mode} \|\|= $mode;
2300	}
2301	}
2302	$app->{mode} \|\| $app->{default_mode} \|\| 'default';
2303	}
2304
2305	sub assert {
2306	my $app = shift;
2307	my $x = shift;
2308	return 1 if $x;
2309	return $app->errtrans(@_);
2310	}
2311
2312	sub takedown {
2313	my $app = shift;
2314
2315	MT->run_callbacks(ref($app) . '::take_down', $app); # arg is the app object
2316
2317	$app->touch_blogs;
2318
2319	my $sess = $app->session;
2320	$sess->save if $sess && $sess->is_dirty;
2321
2322	my $driver = $MT::Object::DRIVER;
2323	$driver->clear_cache if $driver;
2324
2325	require MT::Auth;
2326	MT::Auth->release;
2327
2328	if ($app->config->PerformanceLogging) {
2329	$app->log_times();
2330	}
2331
2332	$app->request->finish;
2333	delete $app->{request};
2334	delete $app->{cookies};
2335	$app->{request_read_config} = 1;
2336	}
2337
2338	sub l10n_filter { $_[0]->translate_templatized($_[1]) }
2339
2340	sub load_widgets {
2341	my $app = shift;
2342	my ($page, $param, $default_widgets) = @_;
2343
2344	my $user = $app->user;
2345	my $blog = $app->blog;
2346	my $blog_id = $blog->id if $blog;
2347	my $scope = $blog_id ? 'blog:'.$blog_id : 'system';
2348	my $resave_widgets = 0;
2349	my $widget_set = $page . ':' . $scope;
2350
2351	# TBD: Fetch list of widgets from user object, or
2352	# use a default list
2353
2354	my $widget_store = $user->widgets;
2355	my $widgets = $widget_store->{$widget_set} if $widget_store;
2356
2357	unless ($widgets) {
2358	$resave_widgets = 1;
2359	$widgets = $default_widgets;
2360
2361	# add the 'new_user' / 'new_install' widget...
2362	unless ($widget_store) {
2363	# Special case for the MT CMS dashboard and initial
2364	# widgets used there.
2365	if ($page eq 'dashboard') {
2366	if ($user->id == 1) {
2367	# first user! good enough guess at this.
2368	$widgets->{new_install} = { order => -2, set => 'main' };
2369	} else {
2370	$widgets->{new_user} = { order => -2, set => 'main' };
2371	}
2372	$widgets->{new_version} = { order => -1, set => 'main' };
2373	}
2374	}
2375	}
2376
2377	my $all_widgets = $app->registry("widgets");
2378	$all_widgets = $app->filter_conditional_list($all_widgets, $page, $scope);
2379
2380	my @loop;
2381	my @ordered_list;
2382	my %orders;
2383	my $order_num = 0;
2384	foreach my $widget_id (keys %$widgets) {
2385	my $widget_param = $widgets->{$widget_id} \|\|= {};
2386	my $order;
2387	if (!($order = $widget_param->{order})) {
2388	$order = ++$order_num;
2389	$widget_param->{order} = $order_num;
2390	$resave_widgets = 1;
2391	}
2392	push @ordered_list, $widget_id;
2393	$orders{$widget_id} = $order;
2394	}
2395	@ordered_list = sort { $orders{$a} <=> $orders{$b} } @ordered_list;
2396
2397	$app->build_widgets(
2398	set => $widget_set,
2399	param => $param,
2400	widgets => $all_widgets,
2401	widget_cfgs => $widgets,
2402	order => \@ordered_list,
2403	) or return;
2404
2405	if ($resave_widgets) {
2406	my $widget_store = $user->widgets();
2407	$widget_store->{$widget_set} = $widgets;
2408	$user->widgets($widget_store);
2409	$user->save;
2410	}
2411	return $param;
2412	}
2413
2414	sub build_widgets {
2415	my $app = shift;
2416	my %params = @_;
2417	my ($widget_set, $param, $widgets, $widget_cfgs, $order, $passthru_param) =
2418	@params{qw( set param widgets widget_cfgs order passthru_param )};
2419	$widget_cfgs \|\|= {};
2420	$order \|\|= [ keys %$widgets ];
2421	$passthru_param \|\|= [ qw( html_head js_include ) ];
2422
2423	my $blog = $app->blog;
2424	my $blog_id = $blog->id if $blog;
2425
2426	# The list of widgets in a user's record
2427	# is going to look like this:
2428	# xxx-1
2429	# xxx-2
2430	# yyy-1
2431	# zzz
2432	# Any numeric suffix is just a means to distinguish
2433	# the instance of the widget from other instances.
2434	# The actual widget id is this minus the instance number.
2435	foreach my $widget_inst (@$order) {
2436	my $widget_id = $widget_inst;
2437