Commit 6e0e47f5944a66a7b891442995633ed47867416b - libmojomojo-perl

Imported Upstream version 1.11+dfsg gregor herrmann 8 years ago

34 changed file(s) with 706 addition(s) and 916 deletion(s). Raw diff Collapse all Expand all

-0

Changes less more

	0
	1	1.11 2014-10-25 20:24:00
	2	- Apply patch from debian downstream to use current PSGI engine
	3	- Add valid answer to registration captcha
	4	- Fix rss bug from prev release (#68)
	5	- Enable admin created users by default. (#90)
	6	- Fix unicode issues in recent versions (Simon Wilper)
	7	- Fix test suite (Simon Wilper):
	8
0	9	1.10 2013-05-13 00:52:00
1	10
2	11	- Sort Google Search formatter params to fix issues with ordering. (#113)

+49

-49

META.yml less more

2	2	author:
3	3	- 'Marcus Ramberg C<marcus@nordaaker.com>'
4	4	build_requires:
5		Email::Sender::Simple: 0.102370
	5	Email::Sender::Simple: '0.102370'
6	6	ExtUtils::MakeMaker: 6.59
7		SQL::Translator: 0.09006
	7	SQL::Translator: '0.09006'
8	8	Test::Differences: 0
9		Test::More: 0.88
10		Test::WWW::Mechanize::Catalyst: 0.51
11		WWW::Mechanize: 1.54
12		WWW::Mechanize::TreeBuilder: 1.10000
	9	Test::More: '0.88'
	10	Test::WWW::Mechanize::Catalyst: '0.51'
	11	WWW::Mechanize: '1.54'
	12	WWW::Mechanize::TreeBuilder: '1.10000'
13	13	configure_requires:
14	14	ExtUtils::MakeMaker: 6.59
15	15	File::Copy::Recursive: 0
16	16	distribution_type: module
17	17	dynamic_config: 1
18		generated_by: 'Module::Install version 1.06'
	18	generated_by: 'Module::Install version 1.14'
19	19	license: perl
20	20	meta-spec:
21	21	url: http://module-build.sourceforge.net/META-spec-v1.4.html

26	26	- inc
27	27	- t
28	28	requires:
29		Algorithm::Diff: 1.1901
	29	Algorithm::Diff: '1.1901'
30	30	Algorithm::Merge: 0
31		Archive::Zip: 1.14
	31	Archive::Zip: '1.14'
32	32	Cache::FastMmap: 1.31
33		Catalyst: 5.90015
34		Catalyst::Action::RenderView: 0.07
35		Catalyst::Authentication::Store::DBIx::Class: 0.101
36		Catalyst::Controller::HTML::FormFu: 0.03007
37		Catalyst::Engine::PSGI: 0
38		Catalyst::Model::DBIC::Schema: 0.01
39		Catalyst::Plugin::Authentication: 0.10005
	33	Catalyst: '5.90015'
	34	Catalyst::Action::RenderView: '0.07'
	35	Catalyst::Authentication::Store::DBIx::Class: '0.101'
	36	Catalyst::Controller::HTML::FormFu: '0.03007'
	37	Catalyst::Model::DBIC::Schema: '0.01'
	38	Catalyst::Plugin::Authentication: '0.10005'
40	39	Catalyst::Plugin::Cache: 0.08
41		Catalyst::Plugin::ConfigLoader: 0.13
	40	Catalyst::Plugin::ConfigLoader: '0.13'
42	41	Catalyst::Plugin::I18N: 0
43	42	Catalyst::Plugin::Session::State::Cookie: 0.11
44	43	Catalyst::Plugin::Session::Store::Cache: 0
45	44	Catalyst::Plugin::Setenv: 0
46		Catalyst::Plugin::Static::Simple: 0.07
47		Catalyst::Plugin::SubRequest: 0.19
48		Catalyst::Plugin::Unicode: 0.8
49		Catalyst::View::Email: 0.14
	45	Catalyst::Plugin::Static::Simple: '0.07'
	46	Catalyst::Plugin::SubRequest: '0.19'
	47	Catalyst::Plugin::Unicode: '0.8'
	48	Catalyst::View::Email: '0.14'
50	49	Catalyst::View::Email::Template: 0
51		Catalyst::View::JSON: 0.26
52		Catalyst::View::TT: 0.23
	50	Catalyst::View::JSON: '0.26'
	51	Catalyst::View::TT: '0.23'
53	52	Config::General: 0
54	53	Config::JFDI: 0
55		Crypt::CBC: 2.12
56		DBD::SQLite: 1.27
57		DBIx::Class: 0.08
58		DBIx::Class::DateTime::Epoch: 0.04
	54	Crypt::CBC: '2.12'
	55	DBD::SQLite: '1.27'
	56	DBIx::Class: '0.08'
	57	DBIx::Class::DateTime::Epoch: '0.04'
59	58	DBIx::Class::EncodedColumn: 0
60		DBIx::Class::TimeStamp: 0.11
61		Data::Page: 2.00
62		DateTime: 0.28
	59	DBIx::Class::TimeStamp: '0.11'
	60	Data::Page: '2.00'
	61	DateTime: '0.28'
63	62	DateTime::Format::Mail: 0
64		Directory::Scratch: 0.14
65		Encode: 2.31
	63	Directory::Scratch: '0.14'
	64	Encode: '2.31'
66	65	FCGI::ProcManager: 0
67	66	File::Copy::Recursive: 0
68		File::MMagic: 1.27
69		HTML::Entities: 3.60
70		HTML::FormFu: 0.02000
	67	File::MMagic: '1.27'
	68	HTML::Entities: '3.60'
	69	HTML::FormFu: '0.02000'
71	70	HTML::FormFu::Element::reCAPTCHA: 0
72	71	HTML::FormFu::Model::DBIC: 0
73		HTML::Strip: 1.04
	72	HTML::Strip: '1.04'
74	73	HTML::TagCloud: 0
75	74	HTML::Toc: 0
76		IO::File: 1.14
	75	IO::File: '1.14'
77	76	IO::Scalar: 0
78	77	Image::ExifTool: 0
79	78	Image::Math::Constrain: 0
80	79	Imager: 0
81		KinoSearch1: 1.00
	80	KinoSearch1: '1.00'
82	81	LWP::Simple: 0
83		MRO::Compat: 0.10
84		Module::Pluggable::Ordered: 1.4
	82	MRO::Compat: '0.10'
	83	Module::Pluggable::Ordered: '1.4'
85	84	Moose: 0
86	85	Net::Amazon: 0
87	86	Number::Format: 0
88	87	Plack: 0.9974
89		Pod::Simple::HTML: 3.01
	88	Pod::Simple::HTML: '3.01'
90	89	Syntax::Highlight::Engine::Kate: 0
91		Template: 2.20
	90	Template: '2.20'
92	91	Template::Plugin::JavaScript: 0
93	92	Term::Prompt: 0
94		Text::Context: 3.5
95		Text::MultiMarkdown: 1.000032
	93	Text::Context: '3.5'
	94	Text::Emoticon::MSN: 0
	95	Text::MultiMarkdown: '1.000032'
96	96	Text::Password::Pronounceable: 0
97	97	Text::Textile: 0
98		URI: 1.37
	98	URI: '1.37'
99	99	URI::Fetch: 0
100	100	URI::Find: 0
101	101	XML::Feed: 0
102		XML::LibXML: 1.66
103		XML::LibXSLT: 1.66
104		YAML: 0.36
	102	XML::LibXML: '1.66'
	103	XML::LibXSLT: '1.66'
	104	YAML: '0.36'
105	105	parent: 0
106	106	perl: 5.8.4
107	107	resources:

110	110	homepage: http://mojomojo.org
111	111	license: http://dev.perl.org/licenses/
112	112	repository: http://github.com/mojomojo/mojomojo/
113		version: 1.10
	113	version: '1.11'

-2

Makefile.PL less more

17	17	'Catalyst::Action::RenderView' => '0.07',
18	18	'Catalyst::Authentication::Store::DBIx::Class' => '0.101',
19	19	'Catalyst::Controller::HTML::FormFu' => '0.03007',
20		'Catalyst::Engine::PSGI' => '0',
21	20	'Catalyst::Model::DBIC::Schema' => '0.01',
22	21	'Catalyst::Plugin::Authentication' => '0.10005',
23	22	'Catalyst::Plugin::Cache' => 0.08,

75	74	'URI::Find' => 0,
76	75	'YAML' => '0.36',
77	76	'Term::Prompt' => 0,
	77	'Text::Emoticon::MSN' => 0,
78	78	);
79	79
80	80	feature 'Create new database', 'SQL::Translator' => '0.09006';

110	110	tests(join ' ', (glob('t/.t'), glob('t//*.t')));
111	111
112	112	catalyst;
113		catalyst_par_script('script/mojomojo_server.pl');
	113	#catalyst_par_script('script/mojomojo_server.pl');
114	114
115	115	install_script glob('script/*.pl');
116	116	auto_install;

-6

~~README~~ less more

0		Installation: See INSTALL or lib/MojoMojo/Installation.pod
1
2		After Installation: Run script/mojomojo_server.pl to test the application.
3
4		License: This is free software. You can redistribute it and/or modify
5		it under the same terms as perl itself.

-2

app.psgi less more

3	3	use lib 'lib';
4	4	use MojoMojo;
5	5
6		MojoMojo->setup_engine('PSGI');
7		my $app = sub { MojoMojo->run(@_) };
	6	my $app = MojoMojo->psgi_app(@_);
8	7

+25

-21

inc/Module/AutoInstall.pm less more

7	7
8	8	use vars qw{$VERSION};
9	9	BEGIN {
10		$VERSION = '1.06';
	10	$VERSION = '1.14';
11	11	}
12	12
13	13	# special map on pre-defined feature sets

114	114	print "*** $class version " . $class->VERSION . "\n";
115	115	print "*** Checking for Perl dependencies...\n";
116	116
117		my $cwd = Cwd::cwd();
	117	my $cwd = Cwd::getcwd();
118	118
119	119	$Config = [];
120	120

165	165	$modules = [ %{$modules} ] if UNIVERSAL::isa( $modules, 'HASH' );
166	166
167	167	unshift @$modules, -default => &{ shift(@$modules) }
168		if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward combatability
	168	if ( ref( $modules->[0] ) eq 'CODE' ); # XXX: bugward compatibility
169	169
170	170	while ( my ( $mod, $arg ) = splice( @$modules, 0, 2 ) ) {
171	171	if ( $mod =~ m/^-(\w+)$/ ) {

344	344	my $i; # used below to strip leading '-' from config keys
345	345	my @config = ( map { s/^-// if ++$i; $_ } @{ +shift } );
346	346
347		my ( @modules, @installed );
348		while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
349
350		# grep out those already installed
351		if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) {
352		push @installed, $pkg;
353		}
354		else {
355		push @modules, $pkg, $ver;
356		}
357		}
358
359		if ($UpgradeDeps) {
360		push @modules, @installed;
361		@installed = ();
362		}
	347	my ( @modules, @installed, @modules_to_upgrade );
	348	while (my ($pkg, $ver) = splice(@_, 0, 2)) {
	349
	350	# grep out those already installed
	351	if (_version_cmp(_version_of($pkg), $ver) >= 0) {
	352	push @installed, $pkg;
	353	if ($UpgradeDeps) {
	354	push @modules_to_upgrade, $pkg, $ver;
	355	}
	356	}
	357	else {
	358	push @modules, $pkg, $ver;
	359	}
	360	}
	361
	362	if ($UpgradeDeps) {
	363	push @modules, @modules_to_upgrade;
	364	@installed = ();
	365	@modules_to_upgrade = ();
	366	}
363	367
364	368	return @installed unless @modules; # nothing to do
365	369	return @installed if _check_lock(); # defer to the CPAN shell

610	614	require Cwd;
611	615	require File::Spec;
612	616
613		my $cwd = File::Spec->canonpath( Cwd::cwd() );
	617	my $cwd = File::Spec->canonpath( Cwd::getcwd() );
614	618	my $cpan = File::Spec->canonpath( $CPAN::Config->{cpan_home} );
615	619
616	620	return ( index( $cwd, $cpan ) > -1 );

926	930
927	931	__END__
928	932
929		#line 1193
	933	#line 1197

-1

inc/Module/Install/AutoInstall.pm less more

5	5
6	6	use vars qw{$VERSION @ISA $ISCORE};
7	7	BEGIN {
8		$VERSION = '1.06';
	8	$VERSION = '1.14';
9	9	@ISA = 'Module::Install::Base';
10	10	$ISCORE = 1;
11	11	}

-1

inc/Module/Install/Base.pm less more

3	3	use strict 'vars';
4	4	use vars qw{$VERSION};
5	5	BEGIN {
6		$VERSION = '1.06';
	6	$VERSION = '1.14';
7	7	}
8	8
9	9	# Suspend handler for "redefined" warnings

-1

inc/Module/Install/Can.pm less more

7	7
8	8	use vars qw{$VERSION @ISA $ISCORE};
9	9	BEGIN {
10		$VERSION = '1.06';
	10	$VERSION = '1.14';
11	11	@ISA = 'Module::Install::Base';
12	12	$ISCORE = 1;
13	13	}

-244

inc/Module/Install/Catalyst.pm less more

2	2
3	3	use strict;
4	4
	5	use base qw/ Module::Install::Base /;
5	6	our @ISA;
6	7	require Module::Install::Base;
7		@ISA = qw/Module::Install::Base/;
8	8
9	9	use File::Find;
10	10	use FindBin;

19	19	qw/Build Build.PL Changes MANIFEST META.yml Makefile.PL Makefile README
20	20	_build blib lib script t inc .*\.svn \.git _darcs \.bzr \.hg
21	21	debian build-stamp install-stamp configure-stamp/;
22		our @CLASSES = ();
23		our $ENGINE = 'CGI';
24		our $SCRIPT = '';
25		our $USAGE = '';
26		our %PAROPTS = ();
27	22
28		#line 57
	23	#line 52
29	24
30	25	sub catalyst {
31	26	my $self = shift;

38	33	*** Module::Install::Catalyst
39	34	EOF
40	35	$self->catalyst_files;
41		$self->catalyst_par;
42	36	print <<EOF;
43	37	*** Module::Install::Catalyst finished.
44	38	EOF
45	39	}
46	40
47		#line 82
	41	#line 76
48	42
49	43	sub catalyst_files {
50	44	my $self = shift;

68	62	}
69	63	}
70	64
71		#line 110
	65	#line 104
72	66
73	67	sub catalyst_ignore_all {
74	68	my ( $self, $ignore ) = @_;
75	69	@IGNORE = @$ignore;
76	70	}
77	71
78		#line 121
	72	#line 115
79	73
80	74	sub catalyst_ignore {
81	75	my ( $self, @ignore ) = @_;
82	76	push @IGNORE, @ignore;
83	77	}
84	78
85		#line 130
86
87		# Workaround for a namespace conflict
88		sub catalyst_par {
89		my ( $self, $par ) = @_;
90		$par \|\|= '';
91		return if $SAFETY;
92		$SAFETY++;
93		my $name = $self->name;
94		my $usage = $USAGE;
95		$usage =~ s/"/\\"/g;
96		my $class_string = join "', '", @CLASSES;
97		$class_string = "'$class_string'" if $class_string;
98		local $Data::Dumper::Indent = 0;
99		local $Data::Dumper::Terse = 1;
100		local $Data::Dumper::Pad = ' ';
101		my $paropts_string = Dumper(\%PAROPTS) \|\| "{ }";
102		$self->postamble(<<EOF);
103		catalyst_par :: all
104		\t\$(NOECHO) \$(PERL) -Ilib -Minc::Module::Install -MModule::Install::Catalyst -e"Catalyst::Module::Install::_catalyst_par( '$par', '$name', { CLASSES => [$class_string], PAROPTS => $paropts_string, ENGINE => '$ENGINE', SCRIPT => '$SCRIPT', USAGE => q#$usage# } )"
105		EOF
106		print <<EOF;
107		Please run "make catalyst_par" to create the PAR package!
108		EOF
109		}
110
111		#line 158
112
113		sub catalyst_par_core {
114		my ( $self, $core ) = @_;
115		$core ? ( $PAROPTS{'B'} = $core ) : $PAROPTS{'B'}++;
116		}
117
118		#line 167
119
120		sub catalyst_par_classes {
121		my ( $self, @classes ) = @_;
122		push @CLASSES, @classes;
123		}
124
125		#line 176
126
127		sub catalyst_par_engine {
128		my ( $self, $engine ) = @_;
129		$ENGINE = $engine;
130		}
131
132		#line 185
133
134		sub catalyst_par_multiarch {
135		my ( $self, $multiarch ) = @_;
136		$multiarch ? ( $PAROPTS{'m'} = $multiarch ) : $PAROPTS{'m'}++;
137		}
138
139		#line 218
140
141		sub catalyst_par_options {
142		my ( $self, $optstring ) = @_;
143		eval "use PAR::Packer ()";
144		if ($@) {
145		warn "WARNING: catalyst_par_options ignored - you need PAR::Packer\n"
146		}
147		else {
148		my $p = Getopt::Long::Parser->new(config => ['no_ignore_case']);
149		my %o;
150		require Text::ParseWords;
151		{
152		local @ARGV = Text::ParseWords::shellwords($optstring);
153		$p->getoptions(\%o, PAR::Packer->options);
154		}
155		%PAROPTS = ( %PAROPTS, %o);
156		}
157		}
158
159		#line 240
160
161		sub catalyst_par_script {
162		my ( $self, $script ) = @_;
163		$SCRIPT = $script;
164		}
165
166		#line 249
167
168		sub catalyst_par_usage {
169		my ( $self, $usage ) = @_;
170		$USAGE = $usage;
171		}
172
173		package Catalyst::Module::Install;
174
175		use strict;
176		use FindBin;
177		use File::Copy::Recursive 'rmove';
178		use File::Spec ();
179
180		sub _catalyst_par {
181		my ( $par, $class_name, $opts ) = @_;
182
183		my $ENGINE = $opts->{ENGINE};
184		my $CLASSES = $opts->{CLASSES} \|\| [];
185		my $USAGE = $opts->{USAGE};
186		my $SCRIPT = $opts->{SCRIPT};
187		my $PAROPTS = $opts->{PAROPTS};
188
189		my $name = $class_name;
190		$name =~ s/::/_/g;
191		$name = lc $name;
192		$par \|\|= "$name.par";
193		my $engine = $ENGINE \|\| 'CGI';
194
195		# Check for PAR
196		eval "use PAR ()";
197		die "Please install PAR\n" if $@;
198		eval "use PAR::Packer ()";
199		die "Please install PAR::Packer\n" if $@;
200		eval "use App::Packer::PAR ()";
201		die "Please install App::Packer::PAR\n" if $@;
202		eval "use Module::ScanDeps ()";
203		die "Please install Module::ScanDeps\n" if $@;
204
205		my $root = $FindBin::Bin;
206		$class_name =~ s/-/::/g;
207		my $path = File::Spec->catfile( 'blib', 'lib', split( '::', $class_name ) );
208		$path .= '.pm';
209		unless ( -f $path ) {
210		print qq/Not writing PAR, "$path" doesn't exist\n/;
211		return 0;
212		}
213		print qq/Writing PAR "$par"\n/;
214		chdir File::Spec->catdir( $root, 'blib' );
215
216		my $par_pl = 'par.pl';
217		unlink $par_pl;
218
219		my $version = $Catalyst::VERSION;
220		my $class = $class_name;
221
222		my $classes = '';
223		$classes .= " require $_;\n" for @$CLASSES;
224
225		unlink $par_pl;
226
227		my $usage = $USAGE \|\| <<"EOF";
228		Usage:
229		[parl] $name\[.par] [script] [arguments]
230
231		Examples:
232		parl $name.par $name\_server.pl -r
233		myapp $name\_cgi.pl
234		EOF
235
236		my $script = $SCRIPT;
237		my $tmp_file = IO::File->new("> $par_pl ");
238		print $tmp_file <<"EOF";
239		if ( \$ENV{PAR_PROGNAME} ) {
240		my \$zip = \$PAR::LibCache{\$ENV{PAR_PROGNAME}}
241		\|\| Archive::Zip->new(__FILE__);
242		my \$script = '$script';
243		\$ARGV[0] \|\|= \$script if \$script;
244		if ( ( \@ARGV == 0 ) \|\| ( \$ARGV[0] eq '-h' ) \|\| ( \$ARGV[0] eq '-help' )) {
245		my \@members = \$zip->membersMatching('.script/.\.pl');
246		my \$list = " Available scripts:\\n";
247		for my \$member ( \@members ) {
248		my \$name = \$member->fileName;
249		\$name =~ /(\\w+\\.pl)\$/;
250		\$name = \$1;
251		next if \$name =~ /^main\.pl\$/;
252		next if \$name =~ /^par\.pl\$/;
253		\$list .= " \$name\\n";
254		}
255		die <<"END";
256		$usage
257		\$list
258		END
259		}
260		my \$file = shift \@ARGV;
261		\$file =~ s/^.*[\\/\\\\]//;
262		\$file =~ s/\\.[^.]*\$//i;
263		my \$member = eval { \$zip->memberNamed("./script/\$file.pl") };
264		die qq/Can't open perl script "\$file"\n/ unless \$member;
265		PAR::_run_member( \$member, 1 );
266		}
267		else {
268		require lib;
269		import lib 'lib';
270		\$ENV{CATALYST_ENGINE} = '$engine';
271		require $class;
272		import $class;
273		require Catalyst::Helper;
274		require Catalyst::Test;
275		require Catalyst::Engine::HTTP;
276		require Catalyst::Engine::CGI;
277		require Catalyst::Controller;
278		require Catalyst::Model;
279		require Catalyst::View;
280		require Getopt::Long;
281		require Pod::Usage;
282		require Pod::Text;
283		$classes
284		}
285		EOF
286		$tmp_file->close;
287
288		# Create package
289		local $SIG{__WARN__} = sub { };
290
291		# STDERR used to be redirected to null, but this hid errors from PAR::Packer
292		my %opt = (
293		%{$PAROPTS},
294		# take user defined options first and override them with harcoded defaults
295		'x' => 1,
296		'n' => 0,
297		'o' => $par,
298		'p' => 1,
299		);
300		# do not replace the whole $opt{'a'} array; just push required default value
301		push @{$opt{'a'}}, grep( !/par.pl/, glob '.' );
302
303		App::Packer::PAR->new(
304		frontend => 'Module::ScanDeps',
305		backend => 'PAR::Packer',
306		frontopts => \%opt,
307		backopts => \%opt,
308		args => ['par.pl'],
309		)->go;
310
311		unlink $par_pl;
312		chdir $root;
313		rmove( File::Spec->catfile( 'blib', $par ), $par );
314		return 1;
315		}
316
317		#line 409
	79	#line 131
318	80
319	81	1;

-1

inc/Module/Install/Fetch.pm less more

5	5
6	6	use vars qw{$VERSION @ISA $ISCORE};
7	7	BEGIN {
8		$VERSION = '1.06';
	8	$VERSION = '1.14';
9	9	@ISA = 'Module::Install::Base';
10	10	$ISCORE = 1;
11	11	}

-1

inc/Module/Install/Include.pm less more

5	5
6	6	use vars qw{$VERSION @ISA $ISCORE};
7	7	BEGIN {
8		$VERSION = '1.06';
	8	$VERSION = '1.14';
9	9	@ISA = 'Module::Install::Base';
10	10	$ISCORE = 1;
11	11	}

-2

inc/Module/Install/Makefile.pm less more

7	7
8	8	use vars qw{$VERSION @ISA $ISCORE};
9	9	BEGIN {
10		$VERSION = '1.06';
	10	$VERSION = '1.14';
11	11	@ISA = 'Module::Install::Base';
12	12	$ISCORE = 1;
13	13	}

132	132	return $args;
133	133	}
134	134
135		# For mm args that take multiple space-seperated args,
	135	# For mm args that take multiple space-separated args,
136	136	# append an argument to the current list.
137	137	sub makemaker_append {
138	138	my $self = shift;

-3

inc/Module/Install/Metadata.pm less more

5	5
6	6	use vars qw{$VERSION @ISA $ISCORE};
7	7	BEGIN {
8		$VERSION = '1.06';
	8	$VERSION = '1.14';
9	9	@ISA = 'Module::Install::Base';
10	10	$ISCORE = 1;
11	11	}

346	346	^ \s*
347	347	package \s*
348	348	([\w:]+)
349		\s* ;
	349	[\s\|;]*
350	350	/ixms
351	351	) {
352	352	my ($name, $module_name) = ($1, $1);

704	704	my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
705	705	my $meta = $yaml[0];
706	706
707		# Overwrite the non-configure dependency hashs
	707	# Overwrite the non-configure dependency hashes
708	708	delete $meta->{requires};
709	709	delete $meta->{build_requires};
710	710	delete $meta->{recommends};

-1

inc/Module/Install/Scripts.pm less more

5	5
6	6	use vars qw{$VERSION @ISA $ISCORE};
7	7	BEGIN {
8		$VERSION = '1.06';
	8	$VERSION = '1.14';
9	9	@ISA = 'Module::Install::Base';
10	10	$ISCORE = 1;
11	11	}

-1

inc/Module/Install/Win32.pm less more

5	5
6	6	use vars qw{$VERSION @ISA $ISCORE};
7	7	BEGIN {
8		$VERSION = '1.06';
	8	$VERSION = '1.14';
9	9	@ISA = 'Module::Install::Base';
10	10	$ISCORE = 1;
11	11	}

-1

inc/Module/Install/WriteAll.pm less more

5	5
6	6	use vars qw{$VERSION @ISA $ISCORE};
7	7	BEGIN {
8		$VERSION = '1.06';
	8	$VERSION = '1.14';
9	9	@ISA = qw{Module::Install::Base};
10	10	$ISCORE = 1;
11	11	}

+13

-9

inc/Module/Install.pm less more

16	16	# 3. The ./inc/ version of Module::Install loads
17	17	# }
18	18
19		use 5.005;
	19	use 5.006;
20	20	use strict 'vars';
21	21	use Cwd ();
22	22	use File::Find ();

30	30	# This is not enforced yet, but will be some time in the next few
31	31	# releases once we can make sure it won't clash with custom
32	32	# Module::Install extensions.
33		$VERSION = '1.06';
	33	$VERSION = '1.14';
34	34
35	35	# Storage for the pseudo-singleton
36	36	$MAIN = undef;

155	155	sub autoload {
156	156	my $self = shift;
157	157	my $who = $self->_caller;
158		my $cwd = Cwd::cwd();
	158	my $cwd = Cwd::getcwd();
159	159	my $sym = "${who}::AUTOLOAD";
160	160	$sym->{$cwd} = sub {
161		my $pwd = Cwd::cwd();
	161	my $pwd = Cwd::getcwd();
162	162	if ( my $code = $sym->{$pwd} ) {
163	163	# Delegate back to parent dirs
164	164	goto &$code unless $cwd eq $pwd;

238	238
239	239	# ignore the prefix on extension modules built from top level.
240	240	my $base_path = Cwd::abs_path($FindBin::Bin);
241		unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
	241	unless ( Cwd::abs_path(Cwd::getcwd()) eq $base_path ) {
242	242	delete $args{prefix};
243	243	}
244	244	return $args{_self} if $args{_self};

337	337	if ( $subpath eq lc($subpath) \|\| $subpath eq uc($subpath) ) {
338	338	my $content = Module::Install::_read($subpath . '.pm');
339	339	my $in_pod = 0;
340		foreach ( split //, $content ) {
	340	foreach ( split /\n/, $content ) {
341	341	$in_pod = 1 if /^=\w/;
342	342	$in_pod = 0 if /^=cut/;
343	343	next if ($in_pod \|\| /^=cut/); # skip pod text

377	377	sub _read {
378	378	local *FH;
379	379	open( FH, '<', $_[0] ) or die "open($_[0]): $!";
	380	binmode FH;
380	381	my $string = do { local $/; <FH> };
381	382	close FH or die "close($_[0]): $!";
382	383	return $string;

385	386	sub _read {
386	387	local *FH;
387	388	open( FH, "< $_[0]" ) or die "open($_[0]): $!";
	389	binmode FH;
388	390	my $string = do { local $/; <FH> };
389	391	close FH or die "close($_[0]): $!";
390	392	return $string;

415	417	sub _write {
416	418	local *FH;
417	419	open( FH, '>', $_[0] ) or die "open($_[0]): $!";
	420	binmode FH;
418	421	foreach ( 1 .. $#_ ) {
419	422	print FH $_[$_] or die "print($_[0]): $!";
420	423	}

424	427	sub _write {
425	428	local *FH;
426	429	open( FH, "> $_[0]" ) or die "open($_[0]): $!";
	430	binmode FH;
427	431	foreach ( 1 .. $#_ ) {
428	432	print FH $_[$_] or die "print($_[0]): $!";
429	433	}

433	437
434	438	# _version is for processing module versions (eg, 1.03_05) not
435	439	# Perl versions (eg, 5.8.1).
436		sub _version ($) {
	440	sub _version {
437	441	my $s = shift \|\| 0;
438	442	my $d =()= $s =~ /(\.)/g;
439	443	if ( $d >= 2 ) {

449	453	return $l + 0;
450	454	}
451	455
452		sub _cmp ($$) {
	456	sub _cmp {
453	457	_version($_[1]) <=> _version($_[2]);
454	458	}
455	459
456	460	# Cloned from Params::Util::_CLASS
457		sub _CLASS ($) {
	461	sub _CLASS {
458	462	(
459	463	defined $_[0]
460	464	and

-0

lib/MojoMojo/Controller/Attachment.pm less more

157	157
158	158	sub attachment : Chained CaptureArgs(1) {
159	159	my ( $self, $c, $att ) = @_;
	160
	161	# DBIC complains if find argument is not numeric
	162	if ( $att !~ /^\d+$/ ) {
	163	$c->detach('default');
	164	}
160	165	$c->stash->{att} = $c->model("DBIC::Attachment")->find($att)
161	166	or $c->detach('default');
162	167	}

-1

lib/MojoMojo/Controller/Jsrpc.pm less more

50	50
51	51	sub child_menu : Local {
52	52	my ( $self, $c, $page_id ) = @_;
53		$c->stash->{parent_page} = $c->model("DBIC::Page")->find( $c->req->params->{page_id} );
	53
	54	# DBIC complains if find argument is not numeric
	55	if ( $c->req->params->{page_id} =~ /^\d+$/ ) {
	56	$c->stash->{parent_page} = $c->model("DBIC::Page")->find( $c->req->params->{page_id} );
	57	}
	58
54	59	$c->stash->{template} = 'child_menu.tt';
55	60	}
56	61

-2

lib/MojoMojo/Controller/User.pm less more

278	278	$form->model->update( $c->stash->{newuser} );
279	279	$c->stash->{newuser}->insert();
280	280	if ( $c->stash->{user} && $c->stash->{user}->is_admin ) {
	281	$c->stash->{newuser}->update({active=>1});
281	282	$c->res->redirect( $c->uri_for('/.admin/user') );
282	283	}
283	284	else {

349	350	my ( $self, $c, $user, $check ) = @_;
350	351	$user = $c->model("DBIC::Person")->find( { login => $user } );
351	352	if ( $user and $check eq md5_hex( $user->email . $c->pref('entropy') ) ) {
352		$user->active(1);
353		$user->update();
	353	$user->update({active=>1});
354	354	if ( $c->stash->{user} ) {
355	355	$c->res->redirect(
356	356	$c->uri_for( '/', $c->stash->{user}->link, '.edit' ) );

-1

lib/MojoMojo/Formatter/RSS.pm less more

89	89	$content .= '<div class="feed">'
90	90	. '<h3><a href="'.$entry->link.'">'
91	91	. ($entry->title\|\|"no title").'</a></h3>'
92		. ($entry->summary->body\|\|$entry->summary->body\|\|"")."</div>\n";
	92	. ($entry->content->body\|\|$entry->summary->body\|\|"")."</div>\n";
93	93	return $content if $count==$entries;
94	94	}
95	95	return $content;

-1

lib/MojoMojo/Formatter/Wiki.pm less more

82	82	# but why the question mark ('\?') at the end?
83	83	my $non_wikiword_chars =
84	84	( join '', _explicit_start_delims() ) . $wikiword_escape . '\/' . '\?';
85		return qr{( ?<! [$non_wikiword_chars] )}x;
	85	return qr{(?<! [$non_wikiword_chars])}x;
86	86	}
87	87
88	88	my $non_wikiword_check = _generate_non_wikiword_check();

+27

-31

lib/MojoMojo/I18N/de.po less more

202	202
203	203	#: root/forms/admin/settings.yml:99
204	204	msgid "Attachment allowed by default"
205		msgstr ""
	205	msgstr "Anhang standardmäßig erlaubt"
206	206
207	207	#: lib/MojoMojo/Controller/Attachment.pm:58
208	208	msgid "Attachment not found."

222	222
223	223	#: root/base/navbar.tt:12
224	224	msgid "Authors"
225		msgstr "Authoren"
	225	msgstr "Autoren"
226	226
227	227	#: root/base/page/list.tt:50
228	228	msgid "Authors in this path"
229		msgstr ""
	229	msgstr "Autoren von Seiten unterhalb dieses Pfades"
230	230
231	231	#: root/base/page/bottomnav.tt:24 root/base/page/bottomnav.tt:41
232	232	msgid "Back in time"

270	270
271	271	#: root/forms/admin/settings.yml:74
272	272	msgid "Cache permission data"
273		msgstr ""
	273	msgstr "Berechtigungsdaten zwischenspeichern"
274	274
275	275	#: root/base/gallery/photo_info.tt:4
276	276	msgid "Camera"

314	314
315	315	#: root/forms/admin/settings.yml:69
316	316	msgid "Check permission on view"
317		msgstr ""
	317	msgstr "Berechtigungen bei Anzeige prüfen"
318	318
319	319	#: root/base/page/info.tt:51
320	320	msgid "Children"

405	405
406	406	#: root/forms/admin/settings.yml:79
407	407	msgid "Create allowed by default"
408		msgstr ""
	408	msgstr "Erstellen standardmäßig erlaubt"
409	409
410	410	#: root/base/page/edit.tt:62
411	411	msgid "Create and View"

413	413
414	414	#: root/base/page/info.tt:21
415	415	msgid "Created by"
416		msgstr ""
	416	msgstr "Erstellt von"
417	417
418	418	#: root/base/edithelp/markdown.tt:150
419	419	msgid "Creates"

446	446
447	447	#: root/forms/admin/settings.yml:84
448	448	msgid "Delete allowed by default"
449		msgstr ""
	449	msgstr "Löschen standardmäßig erlaubt"
450	450
451	451	#: root/base/page/bottomnav.tt:15
452	452	msgid "Delete page"

470	470
471	471	#: root/forms/admin/settings.yml:47
472	472	msgid "Disable internal search (use Google)"
473		msgstr ""
	473	msgstr "Interne Suche deaktivieren (Google benutzen)"
474	474
475	475	#: root/base/navbar.tt:14
476	476	msgid "Download a ZIP of this page and its subpages"

493	493	msgstr "Bearbeiten"
494	494
495	495	#:
496		msgid "Edit Page"
	496	msgid "Edit page"
497	497	msgstr "Seite bearbeiten"
498	498
499	499	#: root/base/user/profile.tt:10

510	510
511	511	#: root/forms/admin/settings.yml:89
512	512	msgid "Edit allowed by default"
513		msgstr ""
	513	msgstr "Editieren standardmäßig erlaubt"
514	514
515	515	#: root/base/this_page_link.tt:13 root/base/this_page_link.tt:15
516	516	msgid "Edit page"
517		msgstr ""
	517	msgstr "Seite bearbeiten"
518	518
519	519	#: root/base/page/permissions.tt:46
520	520	msgid "Edit permissions for this page"
521		msgstr ""
	521	msgstr "Berechtigungen für diese Seite bearbeiten"
522	522
523	523	#: root/base/page/recent.tt:45
524	524	msgid "Edited by"

555	555
556	556	#: root/forms/admin/settings.yml:50
557	557	msgid "Enable graphical emoticons"
558		msgstr ""
	558	msgstr "Grafische Emoticons verwenden"
559	559
560	560	#: root/forms/admin/settings.yml:64
561	561	msgid "Enforce login"
562		msgstr ""
	562	msgstr "Anmeldung erzwingen"
563	563
564	564	#:
565	565	msgid "Enum list"

947	947
948	948	#: root/forms/admin/settings.yml:29
949	949	msgid "Main formatter"
950		msgstr ""
	950	msgstr "Haupt-Format"
951	951
952	952	#:
953	953	msgid "Main heading"

1087	1087
1088	1088	#: root/base/tag/cloud.tt:5 root/base/tag/cloud.tt:9
1089	1089	msgid "No tags in use."
1090		msgstr ""
	1090	msgstr "Keine Tags in Benutzung"
1091	1091
1092	1092	#:
1093	1093	msgid "Non-Existent Pages"

1164	1164
1165	1165	#: root/base/page/bottomnav.tt:18 root/base/page/bottomnav.tt:20
1166	1166	msgid "Page Info"
1167		msgstr "Seiten-Informationen"
	1167	msgstr "Seiteninformationen"
1168	1168
1169	1169	#: root/base/edithelp/markdown.tt:26
1170	1170	msgid "Page Name Here"

1173	1173	#. (page.path)
1174	1174	#: root/base/page/info.tt:9
1175	1175	msgid "Page info for x"
1176		msgstr "Seiten-Informationen von %1"
	1176	msgstr "Seiteninformationen von %1"
1177	1177
1178	1178	#: root/base/page/bottomnav.tt:18 root/base/page/bottomnav.tt:20
1179	1179	msgid "Page meta information"

1181	1181
1182	1182	#: root/forms/pageadmin/edit.yml:7
1183	1183	msgid "Page text"
1184		msgstr "Seiten-Text"
	1184	msgstr "Seitentext"
1185	1185
1186	1186	#: root/base/navbar.tt:10
1187	1187	msgid "Pages sorted by when they were last changed"

1205	1205
1206	1206	#. ($c->stash->{page}->name)
1207	1207	#: lib/MojoMojo.pm:674
1208		msgid "Permission Denied to view x"
	1208	msgid "Permission denied to view x"
1209	1209	msgstr "Keine Berechtigung um %1 anzusehen"
1210
1211		#:
1212		msgid "Permission Denied to x x"
1213		msgstr "Zugriff verweigert zu %1 %2"
1214	1210
1215	1211	#. ([ $loc_permtocheck, $name ])
1216	1212	#: lib/MojoMojo/Controller/PageAdmin.pm:179
1217	1213	msgid "Permission denied to x x"
1218		msgstr ""
	1214	msgstr "Zugriff verweigert für Aktion '%1' auf Seite '%2'"
1219	1215
1220	1216	#: root/base/page/editbar.tt:11 root/base/page/editbar.tt:15 root/base/page/editbar.tt:5
1221	1217	msgid "Permissions"

1430	1426
1431	1427	#: root/base/page/permissions.tt:33
1432	1428	msgid "Role"
1433		msgstr ""
	1429	msgstr "Rolle"
1434	1430
1435	1431	#: root/base/admin/role_form.tt:13
1436	1432	msgid "Role Members"

1568	1564
1569	1565	#: root/base/page/bottomnav.tt:70
1570	1566	msgid "Site settings"
1571		msgstr ""
	1567	msgstr "Einstellungen"
1572	1568
1573	1569	#: lib/MojoMojo/Controller/User.pm:451
1574	1570	msgid "Some fields are invalid. Please correct them and try again:"

1715	1711
1716	1712	#: root/forms/admin/settings.yml:26
1717	1713	msgid "Theme name"
1718		msgstr ""
	1714	msgstr "Aktuelles Theme"
1719	1715
1720	1716	#:
1721	1717	msgid "This is a pre formatted code block"

1771	1767
1772	1768	#: root/forms/admin/settings.yml:40
1773	1769	msgid "Use captcha"
1774		msgstr ""
	1770	msgstr "CAPTCHA benutzen"
1775	1771
1776	1772	#: root/base/page/permissions.tt:77
1777	1773	msgid "Use inherited permissions"

1829	1825
1830	1826	#: root/forms/admin/settings.yml:94
1831	1827	msgid "View allowed by default"
1832		msgstr ""
	1828	msgstr "Anzeigen standardmäßig erlaubt"
1833	1829
1834	1830	#: root/base/gallery.tt:19
1835	1831	msgid "View as files"

-3

lib/MojoMojo/Schema/ResultSet/Page.pm less more

2	2	use strict;
3	3	use warnings;
4	4	use parent qw/MojoMojo::Schema::Base::ResultSet/;
5		use Encode ();
6	5	use URI::Escape ();
7	6
8	7	=head1 NAME

176	175	$name =~ s/\s+/_/g;
177	176	$name = lc($name);
178	177	return (
179		Encode::decode_utf8(URI::Escape::uri_unescape($name_orig)),
180		Encode::decode_utf8(URI::Escape::uri_unescape($name)),
	178	URI::Escape::uri_unescape($name_orig),
	179	URI::Escape::uri_unescape($name),
181	180	);
182	181	}
183	182

+517

-503

lib/MojoMojo.pm less more

3	3	use Path::Class 'file';
4	4
5	5	use Catalyst qw/
6		ConfigLoader
7		Authentication
8		Cache
9		Session
10		Session::Store::Cache
11		Session::State::Cookie
12		Static::Simple
13		SubRequest
14		Unicode
15		I18N
16		Setenv
17		/;
	6	ConfigLoader
	7	Authentication
	8	Cache
	9	Session
	10	Session::Store::Cache
	11	Session::State::Cookie
	12	Static::Simple
	13	SubRequest
	14	Unicode
	15	I18N
	16	Setenv
	17	/;
18	18
19	19	use Storable;
20	20	use Digest::MD5;

22	22	use DateTime;
23	23	use MRO::Compat;
24	24	use DBIx::Class::ResultClass::HashRefInflator;
25		use Encode ();
	25	use Encode ();
26	26	use URI::Escape ();
27	27	use MojoMojo::Formatter::Wiki;
28	28	use Module::Pluggable::Ordered
29		search_path => 'MojoMojo::Formatter',
30		except => qr/^MojoMojo::Plugin::/,
31		require => 1;
32
33		our $VERSION = '1.10';
	29	search_path => 'MojoMojo::Formatter',
	30	except => qr/^MojoMojo::Plugin::/,
	31	require => 1;
	32
	33	our $VERSION = '1.11';
34	34	use 5.008004;
35	35
36	36	MojoMojo->config->{authentication}{dbic} = {
37		user_class => 'DBIC::Person',
38		user_field => 'login',
39		password_field => 'pass'
	37	user_class => 'DBIC::Person',
	38	user_field => 'login',
	39	password_field => 'pass'
40	40	};
41		MojoMojo->config->{default_view}='TT';
	41	MojoMojo->config->{default_view} = 'TT';
42	42	MojoMojo->config->{'Plugin::Cache'}{backend} = {
43		class => "Cache::FastMmap",
44		unlink_on_exit => 1,
45		share_file => '' . Path::Class::file(
46		File::Spec->tmpdir,
47		'mojomojo-sharefile-'.Digest::MD5::md5_hex(MojoMojo->config->{home})
	43	class => "Cache::FastMmap",
	44	unlink_on_exit => 1,
	45	share_file => ''
	46	. Path::Class::file(
	47	File::Spec->tmpdir,
	48	'mojomojo-sharefile-' . Digest::MD5::md5_hex(MojoMojo->config->{home})
48	49	),
49	50	};
50	51
51		__PACKAGE__->config( authentication => {
	52	__PACKAGE__->config(
	53	authentication => {
52	54	default_realm => 'members',
53	55	use_session => 1,
54		realms => {
55		members => {
56		credential => {
57		class => 'Password',
58		password_field => 'pass',
59		password_type => 'hashed',
60		password_hash_type => 'SHA-1',
61		},
62		store => {
63		class => 'DBIx::Class',
64		user_class => 'DBIC::Person',
65		},
	56	realms => {
	57	members => {
	58	credential => {
	59	class => 'Password',
	60	password_field => 'pass',
	61	password_type => 'hashed',
	62	password_hash_type => 'SHA-1',
66	63	},
67		}
68		});
69
70		__PACKAGE__->config('Controller::HTML::FormFu' => {
71		languages_from_context => 1,
72		localize_from_context => 1,
73		});
74
75		__PACKAGE__->config( setup_components => {
76		search_extra => [ '::Extensions' ],
77		});
	64	store => {class => 'DBIx::Class', user_class => 'DBIC::Person',},
	65	},
	66	}
	67	}
	68	);
	69
	70	__PACKAGE__->config('Controller::HTML::FormFu' =>
	71	{languages_from_context => 1, localize_from_context => 1,});
	72
	73	__PACKAGE__->config(setup_components => {search_extra => ['::Extensions'],});
78	74
79	75	MojoMojo->setup();
80	76
81	77	# Check for deployed database
82		my $has_DB = 1;
83		my $NO_DB_MESSAGE =<<"EOF";
	78	my $has_DB = 1;
	79	my $NO_DB_MESSAGE = <<"EOF";
84	80
85	81	***********************************************
86	82	ERROR. Looks like you need to deploy a database.

88	84	***********************************************
89	85
90	86	EOF
91		eval { MojoMojo->model('DBIC')->schema->resultset('MojoMojo::Schema::Result::Person')->next };
92		if ($@ ) {
93		$has_DB = 0;
94		warn $NO_DB_MESSAGE;
95		warn "(Error: $@)";
96		}
97
98		MojoMojo->model('DBIC')->schema->attachment_dir( MojoMojo->config->{attachment_dir}
99		\|\| MojoMojo->path_to('uploads') . '' );
	87	eval {
	88	MojoMojo->model('DBIC')
	89	->schema->resultset('MojoMojo::Schema::Result::Person')->next;
	90	};
	91	if ($@) {
	92	$has_DB = 0;
	93	warn $NO_DB_MESSAGE;
	94	warn "(Error: $@)";
	95	}
	96
	97	MojoMojo->model('DBIC')
	98	->schema->attachment_dir(MojoMojo->config->{attachment_dir}
	99	\|\| MojoMojo->path_to('uploads') . '');
100	100
101	101	=head1 NAME
102	102

141	141	=cut
142	142
143	143	sub prepare {
144		my $self = shift->next::method(@_);
145		if ( $self->config->{force_ssl} ) {
146		my $request = $self->request;
147		$request->base->scheme('https');
148		$request->uri->scheme('https');
149		}
150		return $self;
	144	my $self = shift->next::method(@_);
	145	if ($self->config->{force_ssl}) {
	146	my $request = $self->request;
	147	$request->base->scheme('https');
	148	$request->uri->scheme('https');
	149	}
	150	return $self;
151	151	}
152	152
153	153

160	160	=cut
161	161
162	162	sub ajax {
163		my ($c) = @_;
164		return $c->req->header('x-requested-with')
165		&& $c->req->header('x-requested-with') eq 'XMLHttpRequest';
	163	my ($c) = @_;
	164	return $c->req->header('x-requested-with')
	165	&& $c->req->header('x-requested-with') eq 'XMLHttpRequest';
166	166	}
167	167
168	168	=head2 expand_wikilink

172	172	=cut
173	173
174	174	sub expand_wikilink {
175		my $c = shift;
176		return MojoMojo::Formatter::Wiki->expand_wikilink(@_);
	175	my $c = shift;
	176	return MojoMojo::Formatter::Wiki->expand_wikilink(@_);
177	177	}
178	178
179	179	=head2 wikiword

183	183	=cut
184	184
185	185	sub wikiword {
186		return MojoMojo::Formatter::Wiki->format_link(@_);
	186	return MojoMojo::Formatter::Wiki->format_link(@_);
187	187	}
188	188
189	189	=head2 pref

194	194	=cut
195	195
196	196	sub pref {
197		my ( $c, $setting, $value ) = @_;
198
199		return unless $setting;
200
201		# Unfortunately there are MojoMojo->pref() calls in
202		# MojoMojo::Schema::Result::Person which makes it hard
203		# to get cache working for those calls - so we'll just
204		# not use caching for those calls.
205		return $c->pref_cached( $setting, $value ) if ref($c) eq 'MojoMojo';
206
207		$setting = $c->model('DBIC::Preference')->find_or_create( { prefkey => $setting } );
208		if ( defined $value ) {
209		$setting->prefvalue($value);
210		$setting->update();
211		return $value;
212		}
213		return (
214		defined $setting->prefvalue()
215		? $setting->prefvalue
216		: ""
217		);
	197	my ($c, $setting, $value) = @_;
	198
	199	return unless $setting;
	200
	201	# Unfortunately there are MojoMojo->pref() calls in
	202	# MojoMojo::Schema::Result::Person which makes it hard
	203	# to get cache working for those calls - so we'll just
	204	# not use caching for those calls.
	205	return $c->pref_cached($setting, $value) if ref($c) eq 'MojoMojo';
	206
	207	$setting
	208	= $c->model('DBIC::Preference')->find_or_create({prefkey => $setting});
	209	if (defined $value) {
	210	$setting->prefvalue($value);
	211	$setting->update();
	212	return $value;
	213	}
	214	return (defined $setting->prefvalue() ? $setting->prefvalue : "");
218	215	}
219	216
220	217	=head2 pref_cached

224	221	=cut
225	222
226	223	sub pref_cached {
227		my ( $c, $setting, $value ) = @_;
228
229		# Already in cache and no new value to set?
230		if ( defined $c->cache->get($setting) and not defined $value ) {
231		return $c->cache->get($setting);
232		}
233		# Check that we have a database, i.e. script/mojomojo_spawn_db.pl was run.
234		my $row;
235		$row = $c->model('DBIC::Preference')->find_or_create( { prefkey => $setting } );
236
237		# Update database
238		$row->update( { prefvalue => $value } ) if defined $value;
239
240		my $prefvalue= $row->prefvalue();
241
242		# if no entry in preferences, try get one from config or get default value
243		unless ( defined $prefvalue) {
244
245		if ($setting eq 'main_formatter' ) {
246		$prefvalue = defined $c->config->{'main_formatter'}
247		? $c->config->{'main_formatter'}
248		: 'MojoMojo::Formatter::Markdown';
249		} elsif ($setting eq 'default_lang' ) {
250		$prefvalue = defined $c->config->{$setting}
251		? $c->config->{$setting}
252		: 'en';
253		} elsif ($setting eq 'name' ) {
254		$prefvalue = defined $c->config->{$setting}
255		? $c->config->{$setting}
256		: 'MojoMojo';
257		} elsif ($setting eq 'theme' ) {
258		$prefvalue = defined $c->config->{$setting}
259		? $c->config->{$setting}
260		: 'default';
261		} elsif ($setting =~ /^(enforce_login\|check_permission_on_view)$/ ) {
262		$prefvalue = defined $c->config->{'permissions'}{$setting}
263		? $c->config->{'permissions'}{$setting}
264		: 0;
265		} elsif ($setting =~ /^(cache_permission_data\|create_allowed\|delete_allowed\|edit_allowed\|view_allowed\|attachment_allowed)$/ ) {
266		$prefvalue = defined $c->config->{'permissions'}{$setting}
267		? $c->config->{'permissions'}{$setting}
268		: 1;
269		} else {
270		$prefvalue = $c->config->{$setting};
271		}
272
273		}
274
275		# Update cache
276		$c->cache->set( $setting => $prefvalue );
277
	224	my ($c, $setting, $value) = @_;
	225
	226	# Already in cache and no new value to set?
	227	if (defined $c->cache->get($setting) and not defined $value) {
278	228	return $c->cache->get($setting);
	229	}
	230
	231	# Check that we have a database, i.e. script/mojomojo_spawn_db.pl was run.
	232	my $row;
	233	$row = $c->model('DBIC::Preference')->find_or_create({prefkey => $setting});
	234
	235	# Update database
	236	$row->update({prefvalue => $value}) if defined $value;
	237
	238	my $prefvalue = $row->prefvalue();
	239
	240	# if no entry in preferences, try get one from config or get default value
	241	unless (defined $prefvalue) {
	242
	243	if ($setting eq 'main_formatter') {
	244	$prefvalue
	245	= defined $c->config->{'main_formatter'}
	246	? $c->config->{'main_formatter'}
	247	: 'MojoMojo::Formatter::Markdown';
	248	}
	249	elsif ($setting eq 'default_lang') {
	250	$prefvalue
	251	= defined $c->config->{$setting} ? $c->config->{$setting} : 'en';
	252	}
	253	elsif ($setting eq 'name') {
	254	$prefvalue
	255	= defined $c->config->{$setting} ? $c->config->{$setting} : 'MojoMojo';
	256	}
	257	elsif ($setting eq 'theme') {
	258	$prefvalue
	259	= defined $c->config->{$setting} ? $c->config->{$setting} : 'default';
	260	}
	261	elsif ($setting =~ /^(enforce_login\|check_permission_on_view)$/) {
	262	$prefvalue
	263	= defined $c->config->{'permissions'}{$setting}
	264	? $c->config->{'permissions'}{$setting}
	265	: 0;
	266	}
	267	elsif ($setting
	268	=~ /^(cache_permission_data\|create_allowed\|delete_allowed\|edit_allowed\|view_allowed\|attachment_allowed)$/
	269	)
	270	{
	271	$prefvalue
	272	= defined $c->config->{'permissions'}{$setting}
	273	? $c->config->{'permissions'}{$setting}
	274	: 1;
	275	}
	276	else {
	277	$prefvalue = $c->config->{$setting};
	278	}
	279
	280	}
	281
	282	# Update cache
	283	$c->cache->set($setting => $prefvalue);
	284
	285	return $c->cache->get($setting);
279	286	}
280	287
281	288	=head2 fixw

286	293	=cut
287	294
288	295	sub fixw {
289		my ( $c, $w ) = @_;
290		$w =~ s/\s/\_/g;
291		$w =~ s/[^\w\/\.]//g;
292		return $w;
	296	my ($c, $w) = @_;
	297	$w =~ s/\s/\_/g;
	298	$w =~ s/[^\w\/\.]//g;
	299	return $w;
293	300	}
294	301
295	302	=head2 tz

299	306	=cut
300	307
301	308	sub tz {
302		my ( $c, $dt ) = @_;
303		if ( $c->user && $c->user->timezone ) {
304		eval { $dt->set_time_zone( $c->user->timezone ) };
305		}
306		return $dt;
	309	my ($c, $dt) = @_;
	310	if ($c->user && $c->user->timezone) {
	311	eval { $dt->set_time_zone($c->user->timezone) };
	312	}
	313	return $dt;
307	314	}
308	315
309	316	=head2 prepare_action

313	320	=cut
314	321
315	322	sub prepare_action {
316		my $c = shift;
317
318		if ($has_DB) {
319		$c->next::method(@_);
320		}
321		else {
322		$c->res->status( 404 );
323		$c->response->body($NO_DB_MESSAGE);
324		return;
325		}
	323	my $c = shift;
	324
	325	if ($has_DB) {
	326	$c->next::method(@_);
	327	}
	328	else {
	329	$c->res->status(404);
	330	$c->response->body($NO_DB_MESSAGE);
	331	return;
	332	}
326	333	}
327	334
328	335	=head2 prepare_path

339	346	=cut
340	347
341	348	sub prepare_path {
342		my $c = shift;
343		$c->next::method(@_);
344		$c->stash->{pre_hacked_uri} = $c->req->uri->clone;
345		my $base = $c->req->base;
346		$base =~ s\|/+$\|\|;
347		$c->req->base( URI->new($base) );
348		my ( $path, $action );
349		$path = $c->req->path;
350
351		if( $path =~ /^special(?:\/\|$)(.*)/ ) {
352		$c->stash->{path} = $path;
353		$c->req->path($1);
354		} else {
355		# find the last period, so that pages can have periods in their name.
356		my $index = index( $path, '.' );
357
358		if ( $index == -1 ) {
359
360		# no action found, default to view
361		$c->stash->{path} = $path;
362		$c->req->path('view');
363		}
364		else {
365
366		# set path in stash, and set req.path to action
367		$c->stash->{path} = substr( $path, 0, $index );
368		$c->req->path( substr( $path, $index + 1 ) );
369		}
370		}
371		$c->stash->{path}='/'.$c->stash->{path} unless ($path=~m!^/!);
	349	my $c = shift;
	350	$c->next::method(@_);
	351	$c->stash->{pre_hacked_uri} = $c->req->uri->clone;
	352	my $base = $c->req->base;
	353	$base =~ s\|/+$\|\|;
	354	$c->req->base(URI->new($base));
	355	my ($path, $action);
	356	$path = $c->req->path;
	357
	358	if ($path =~ /^special(?:\/\|$)(.*)/) {
	359	$c->stash->{path} = $path;
	360	$c->req->path($1);
	361	}
	362	else {
	363	# find the last period, so that pages can have periods in their name.
	364	my $index = index($path, '.');
	365
	366	if ($index == -1) {
	367
	368	# no action found, default to view
	369	$c->stash->{path} = $path;
	370	$c->req->path('view');
	371	}
	372	else {
	373
	374	# set path in stash, and set req.path to action
	375	$c->stash->{path} = substr($path, 0, $index);
	376	$c->req->path(substr($path, $index + 1));
	377	}
	378	}
	379	$c->stash->{path} = '/' . $c->stash->{path} unless ($path =~ m!^/!);
372	380	}
373	381
374	382	=head2 base_uri

378	386	=cut
379	387
380	388	sub base_uri {
381		my $c = shift;
382		return URI->new( $c->req->base );
	389	my $c = shift;
	390	return URI->new($c->req->base);
383	391	}
384	392
385	393	=head2 uri_for

389	397	=cut
390	398
391	399	sub uri_for {
392		my $c = shift;
393		unless ( $_[0] =~ m/^\// ) {
394		my $val = shift @_;
395		my $prefix = $c->stash->{path} =~ m\|^/\| ? '' : '/';
396		unshift( @_, $prefix . $c->stash->{path} . '.' . $val );
397		}
398
399		# do I see unicode here?
400		if (Encode::is_utf8($_[0])) {
401		$_[0] = join('/', map { URI::Escape::uri_escape_utf8($_) } split(/\//, $_[0]) );
402		}
403
404		my $res = $c->next::method(@_);
405		$res->scheme('https') if $c->config->{'force_ssl'};
406		return $res;
	400	my $c = shift;
	401	unless ($_[0] =~ m/^\//) {
	402	my $val = shift @_;
	403	my $prefix = $c->stash->{path} =~ m\|^/\| ? '' : '/';
	404	unshift(@_, $prefix . $c->stash->{path} . '.' . $val);
	405	}
	406
	407	# do I see unicode here?
	408	if (Encode::is_utf8($_[0])) {
	409	$_[0]
	410	= join('/', map { URI::Escape::uri_escape_utf8($_) } split(/\//, $_[0]));
	411	}
	412
	413	my $res = $c->next::method(@_);
	414	$res->scheme('https') if $c->config->{'force_ssl'};
	415	return $res;
407	416	}
408	417
409	418	=head2 uri_for_static

413	422	=cut
414	423
415	424	sub uri_for_static {
416		my ( $self, $asset ) = @_;
417		return
418		( defined($self->config->{static_path} )
419		? $self->config->{static_path} . $asset
420		: $self->uri_for('/.static', $asset) );
421		}
	425	my ($self, $asset) = @_;
	426	return (
	427	defined($self->config->{static_path})
	428	? $self->config->{static_path} . $asset
	429	: $self->uri_for('/.static', $asset));
	430	}
	431
422	432	=head2 _cleanup_path
423	433
424	434	Lowercase the path and remove any double-slashes.

426	436	=cut
427	437
428	438	sub _cleanup_path {
429		my ( $c, $path ) = @_;
430		## Make some changes to the path - we have to do this
431		## because path is not always cleaned up before we get it:
432		## sometimes we get caps, other times we don't. Permissions are
433		## set using lowercase paths.
434
435		## lowercase the path - and ensure it has a leading /
436		my $searchpath = lc($path);
437
438		# clear out any double-slashes
439		$searchpath =~ s\|//\|/\|g;
440
441		return $searchpath;
	439	my ($c, $path) = @_;
	440	## Make some changes to the path - we have to do this
	441	## because path is not always cleaned up before we get it:
	442	## sometimes we get caps, other times we don't. Permissions are
	443	## set using lowercase paths.
	444
	445	## lowercase the path - and ensure it has a leading /
	446	my $searchpath = lc($path);
	447
	448	# clear out any double-slashes
	449	$searchpath =~ s\|//\|/\|g;
	450
	451	return $searchpath;
442	452	}
443	453
444	454	=head2 _expand_path_elements

455	465	=cut
456	466
457	467	sub _expand_path_elements {
458		my ( $c, $path ) = @_;
459		my $searchpath = $c->_cleanup_path( $path );
460
461		my @pathelements = split '/', $searchpath;
462
463		if ( @pathelements && $pathelements[0] eq '' ) {
464		shift @pathelements;
465		}
466
467		my @paths_to_check = ('/');
468
469		my $current_path = '';
470
471		foreach my $pathitem (@pathelements) {
472		$current_path .= "/" . $pathitem;
473		push @paths_to_check, $current_path;
474		}
475
476		return @paths_to_check;
	468	my ($c, $path) = @_;
	469	my $searchpath = $c->_cleanup_path($path);
	470
	471	my @pathelements = split '/', $searchpath;
	472
	473	if (@pathelements && $pathelements[0] eq '') {
	474	shift @pathelements;
	475	}
	476
	477	my @paths_to_check = ('/');
	478
	479	my $current_path = '';
	480
	481	foreach my $pathitem (@pathelements) {
	482	$current_path .= "/" . $pathitem;
	483	push @paths_to_check, $current_path;
	484	}
	485
	486	return @paths_to_check;
477	487	}
478	488
479	489	=head2 get_permissions_data

528	538	=cut
529	539
530	540	sub get_permissions_data {
531		my ( $c, $current_path, $paths_to_check, $role_ids ) = @_;
532
533		# default to roles for current user
534		$role_ids \|\|= $c->user_role_ids( $c->user );
535
536		my $permdata;
537
538		## Now that we have our path elements to check, we have to figure out how we are accessing them.
539		## If we have caching turned on, we load the perms from the cache and walk the tree.
540		## Otherwise we pull what we need out of the DB. The structure is:
541		# $permdata{$pagepath} = {
542		# admin => {
543		# page => {
544		# create => 'yes',
545		# delete => 'yes',
546		# view => 'yes',
547		# edit => 'yes',
548		# attachment => 'yes',
549		# },
550		# subpages => {
551		# create => 'yes',
552		# delete => 'yes',
553		# view => 'yes',
554		# edit => 'yes',
555		# attachment => 'yes',
556		# },
557		# },
558		# users => .....
559		# }
560		if ( $c->pref('cache_permission_data') ){
561		$permdata = $c->cache->get('page_permission_data');
562		}
563
564		# If we don't have any permissions data, we have a problem. We need to load it.
565		# We have two options here - if we are caching, we will load everything and cache it.
566		# If we are not - then we load just the bits we need.
567		if ( !$permdata ) {
568		# Initialize $permdata as a reference or we end up with an error
569		# when we try to dereference it further down. The error we're avoiding is:
570		# Can't use string ("") as a HASH ref while "strict refs"
571		$permdata = {};
572
573		## Either the data hasn't been loaded, or it's expired since we used it last,
574		## so we need to reload it.
575		my $rs =
576		$c->model('DBIC::PathPermissions')
577		->search( undef, { order_by => 'length(path),role,apply_to_subpages' } );
578
579		# If we are not caching, we don't return the whole enchilada.
580		if ( ! $c->pref('cache_permission_data') ) {
581		## this seems odd to me - but that's what the DBIx::Class says to do.
582		$rs = $rs->search( { role => $role_ids } ) if $role_ids;
583		$rs = $rs->search(
584		{
585		'-or' => [
586		{
587		path => $paths_to_check,
588		apply_to_subpages => 'yes'
589		},
590		{
591		path => $current_path,
592		apply_to_subpages => 'no'
593		}
594		]
595		}
596		);
	541	my ($c, $current_path, $paths_to_check, $role_ids) = @_;
	542
	543	# default to roles for current user
	544	$role_ids \|\|= $c->user_role_ids($c->user);
	545
	546	my $permdata;
	547
	548	## Now that we have our path elements to check, we have to figure out how we are accessing them.
	549	## If we have caching turned on, we load the perms from the cache and walk the tree.
	550	## Otherwise we pull what we need out of the DB. The structure is:
	551	# $permdata{$pagepath} = {
	552	# admin => {
	553	# page => {
	554	# create => 'yes',
	555	# delete => 'yes',
	556	# view => 'yes',
	557	# edit => 'yes',
	558	# attachment => 'yes',
	559	# },
	560	# subpages => {
	561	# create => 'yes',
	562	# delete => 'yes',
	563	# view => 'yes',
	564	# edit => 'yes',
	565	# attachment => 'yes',
	566	# },
	567	# },
	568	# users => .....
	569	# }
	570	if ($c->pref('cache_permission_data')) {
	571	$permdata = $c->cache->get('page_permission_data');
	572	}
	573
	574	# If we don't have any permissions data, we have a problem. We need to load it.
	575	# We have two options here - if we are caching, we will load everything and cache it.
	576	# If we are not - then we load just the bits we need.
	577	if (!$permdata) {
	578
	579	# Initialize $permdata as a reference or we end up with an error
	580	# when we try to dereference it further down. The error we're avoiding is:
	581	# Can't use string ("") as a HASH ref while "strict refs"
	582	$permdata = {};
	583
	584	## Either the data hasn't been loaded, or it's expired since we used it last,
	585	## so we need to reload it.
	586	my $rs = $c->model('DBIC::PathPermissions')
	587	->search(undef, {order_by => 'length(path),role,apply_to_subpages'});
	588
	589	# If we are not caching, we don't return the whole enchilada.
	590	if (!$c->pref('cache_permission_data')) {
	591	## this seems odd to me - but that's what the DBIx::Class says to do.
	592	$rs = $rs->search({role => $role_ids}) if $role_ids;
	593	$rs = $rs->search(
	594	{
	595	'-or' => [
	596	{path => $paths_to_check, apply_to_subpages => 'yes'},
	597	{path => $current_path, apply_to_subpages => 'no'}
	598	]
597	599	}
598		$rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
599
600		my $recordtype;
601		while ( my $record = $rs->next ) {
602		if ( $record->{'apply_to_subpages'} eq 'yes' ) {
603		$recordtype = 'subpages';
	600	);
	601	}
	602	$rs->result_class('DBIx::Class::ResultClass::HashRefInflator');
	603
	604	my $recordtype;
	605	while (my $record = $rs->next) {
	606	if ($record->{'apply_to_subpages'} eq 'yes') {
	607	$recordtype = 'subpages';
	608	}
	609	else {
	610	$recordtype = 'page';
	611	}
	612	%{$permdata->{$record->{'path'}}{$record->{'role'}}{$recordtype}}
	613	= map { $_ => $record->{$_ . "_allowed"} }
	614	qw/create edit view delete attachment/;
	615	}
	616	}
	617
	618	## now we re-cache it - if we need to. # !$c->cache('memory')->exists('page_permission_data')
	619	if ($c->pref('cache_permission_data')) {
	620	$c->cache->set('page_permission_data', $permdata);
	621	}
	622
	623	return $permdata;
	624	}
	625
	626	=head2 user_role_ids
	627
	628	Get the list of role ids for a user.
	629
	630	=cut
	631
	632	sub user_role_ids {
	633	my ($c, $user) = @_;
	634
	635	## always use role_id 0 - which is default role and includes everyone.
	636	my @role_ids = (0);
	637
	638	if (ref($user)) {
	639	push @role_ids, map { $_->role->id } $user->role_members->all;
	640	}
	641
	642	return @role_ids;
	643	}
	644
	645	=head2 check_permissions
	646
	647	Check user permissions for a path.
	648
	649	=cut
	650
	651	sub check_permissions {
	652	my ($c, $path, $user) = @_;
	653
	654	return {attachment => 1, create => 1, delete => 1, edit => 1, view => 1,}
	655	if ($user && $user->is_admin);
	656
	657	# if no user is logged in
	658	if (not $user) {
	659
	660	# if anonymous user is allowed
	661	my $anonymous = $c->pref('anonymous_user');
	662	if ($anonymous) {
	663
	664	# get anonymous user for no logged-in users
	665	$user = $c->model('DBIC::Person')->search({login => $anonymous})->first;
	666	}
	667	}
	668
	669	my @paths_to_check = $c->_expand_path_elements($path);
	670	my $current_path = $paths_to_check[-1];
	671
	672	my @role_ids = $c->user_role_ids($user);
	673
	674	my $permdata
	675	= $c->get_permissions_data($current_path, \@paths_to_check, \@role_ids);
	676
	677	# rules comparison hash
	678	# allow everything by default
	679	my %rulescomparison = (
	680	'create' => {
	681	'allowed' => $c->pref('create_allowed'),
	682	'role' => '__default',
	683	'len' => 0,
	684	},
	685	'delete' => {
	686	'allowed' => $c->pref('delete_allowed'),
	687	'role' => '__default',
	688	'len' => 0,
	689	},
	690	'edit' => {
	691	'allowed' => $c->pref('edit_allowed'),
	692	'role' => '__default',
	693	'len' => 0,
	694	},
	695	'view' => {
	696	'allowed' => $c->pref('view_allowed'),
	697	'role' => '__default',
	698	'len' => 0,
	699	},
	700	'attachment' => {
	701	'allowed' => $c->pref('attachment_allowed'),
	702	'role' => '__default',
	703	'len' => 0,
	704	},
	705	);
	706
	707	## The outcome of this loop is a combined permission set.
	708	## The rule orders are essentially based on how specific the path
	709	## match is. More specific paths override less specific paths.
	710	## When conflicting rules at the same level of path hierarchy
	711	## (with different roles) are discovered, the grant is given precedence
	712	## over the deny. Note that more-specific denies will still
	713	## override.
	714	my $permtype = 'subpages';
	715	foreach my $i (0 .. $#paths_to_check) {
	716	my $path = $paths_to_check[$i];
	717	if ($i == $#paths_to_check) {
	718	$permtype = 'page';
	719	}
	720	foreach my $role (@role_ids) {
	721	if ( exists($permdata->{$path})
	722	&& exists($permdata->{$path}{$role})
	723	&& exists($permdata->{$path}{$role}{$permtype}))
	724	{
	725
	726	my $len = length($path);
	727
	728	foreach my $perm (keys %{$permdata->{$path}{$role}{$permtype}}) {
	729
	730	## if the xxxx_allowed column is null, this permission is ignored.
	731	if (defined($permdata->{$path}{$role}{$permtype}{$perm})) {
	732	if ($len == $rulescomparison{$perm}{'len'}) {
	733	if ($permdata->{$path}{$role}{$permtype}{$perm} eq 'yes') {
	734	$rulescomparison{$perm}{'allowed'} = 1;
	735	$rulescomparison{$perm}{'len'} = $len;
	736	$rulescomparison{$perm}{'role'} = $role;
	737	}
604	738	}
605		else {
606		$recordtype = 'page';
	739	elsif ($len > $rulescomparison{$perm}{'len'}) {
	740	if ($permdata->{$path}{$role}{$permtype}{$perm} eq 'yes') {
	741	$rulescomparison{$perm}{'allowed'} = 1;
	742	}
	743	else {
	744	$rulescomparison{$perm}{'allowed'} = 0;
	745	}
	746	$rulescomparison{$perm}{'len'} = $len;
	747	$rulescomparison{$perm}{'role'} = $role;
607	748	}
608		%{ $permdata->{ $record->{'path'} }{ $record->{'role'} }{$recordtype} } =
609		map { $_ => $record->{ $_ . "_allowed" } }
610		qw/create edit view delete attachment/;
	749	}
611	750	}
612		}
613
614		## now we re-cache it - if we need to. # !$c->cache('memory')->exists('page_permission_data')
615		if ( $c->pref('cache_permission_data') ) {
616		$c->cache->set( 'page_permission_data', $permdata );
617		}
618
619		return $permdata;
620		}
621
622		=head2 user_role_ids
623
624		Get the list of role ids for a user.
625
626		=cut
627
628		sub user_role_ids {
629		my ( $c, $user ) = @_;
630
631		## always use role_id 0 - which is default role and includes everyone.
632		my @role_ids = (0);
633
634		if ( ref($user) ) {
635		push @role_ids, map { $_->role->id } $user->role_members->all;
636		}
637
638		return @role_ids;
639		}
640
641		=head2 check_permissions
642
643		Check user permissions for a path.
644
645		=cut
646
647		sub check_permissions {
648		my ( $c, $path, $user ) = @_;
649
650		return {
651		attachment => 1, create => 1, delete => 1,
652		edit => 1, view => 1,
653		} if ($user && $user->is_admin);
654
655		# if no user is logged in
656		if (not $user) {
657		# if anonymous user is allowed
658		my $anonymous = $c->pref('anonymous_user');
659		if ($anonymous) {
660		# get anonymous user for no logged-in users
661		$user = $c->model('DBIC::Person') ->search( {login => $anonymous} )->first;
662		}
663		}
664
665		my @paths_to_check = $c->_expand_path_elements($path);
666		my $current_path = $paths_to_check[-1];
667
668		my @role_ids = $c->user_role_ids( $user );
669
670		my $permdata = $c->get_permissions_data($current_path, \@paths_to_check, \@role_ids);
671
672		# rules comparison hash
673		# allow everything by default
674		my %rulescomparison = (
675		'create' => {
676		'allowed' => $c->pref('create_allowed'),
677		'role' => '__default',
678		'len' => 0,
679		},
680		'delete' => {
681		'allowed' => $c->pref('delete_allowed'),
682		'role' => '__default',
683		'len' => 0,
684		},
685		'edit' => {
686		'allowed' => $c->pref('edit_allowed'),
687		'role' => '__default',
688		'len' => 0,
689		},
690		'view' => {
691		'allowed' => $c->pref('view_allowed'),
692		'role' => '__default',
693		'len' => 0,
694		},
695		'attachment' => {
696		'allowed' => $c->pref('attachment_allowed'),
697		'role' => '__default',
698		'len' => 0,
699		},
700		);
701
702		## The outcome of this loop is a combined permission set.
703		## The rule orders are essentially based on how specific the path
704		## match is. More specific paths override less specific paths.
705		## When conflicting rules at the same level of path hierarchy
706		## (with different roles) are discovered, the grant is given precedence
707		## over the deny. Note that more-specific denies will still
708		## override.
709		my $permtype = 'subpages';
710		foreach my $i ( 0 .. $#paths_to_check ) {
711		my $path = $paths_to_check[$i];
712		if ( $i == $#paths_to_check ) {
713		$permtype = 'page';
714		}
715		foreach my $role (@role_ids) {
716		if ( exists( $permdata->{$path} )
717		&& exists( $permdata->{$path}{$role} )
718		&& exists( $permdata->{$path}{$role}{$permtype} ) )
719		{
720
721		my $len = length($path);
722
723		foreach my $perm ( keys %{ $permdata->{$path}{$role}{$permtype} } ) {
724
725		## if the xxxx_allowed column is null, this permission is ignored.
726		if ( defined( $permdata->{$path}{$role}{$permtype}{$perm} ) ) {
727		if ( $len == $rulescomparison{$perm}{'len'} ) {
728		if ( $permdata->{$path}{$role}{$permtype}{$perm} eq 'yes' ) {
729		$rulescomparison{$perm}{'allowed'} = 1;
730		$rulescomparison{$perm}{'len'} = $len;
731		$rulescomparison{$perm}{'role'} = $role;
732		}
733		}
734		elsif ( $len > $rulescomparison{$perm}{'len'} ) {
735		if ( $permdata->{$path}{$role}{$permtype}{$perm} eq 'yes' ) {
736		$rulescomparison{$perm}{'allowed'} = 1;
737		}
738		else {
739		$rulescomparison{$perm}{'allowed'} = 0;
740		}
741		$rulescomparison{$perm}{'len'} = $len;
742		$rulescomparison{$perm}{'role'} = $role;
743		}
744		}
745		}
746		}
747		}
748		}
749
750		my %perms = map { $_ => $rulescomparison{$_}{'allowed'} } keys %rulescomparison;
751
752		return \%perms;
	751	}
	752	}
	753	}
	754
	755	my %perms
	756	= map { $_ => $rulescomparison{$_}{'allowed'} } keys %rulescomparison;
	757
	758	return \%perms;
753	759	}
754	760
755	761	=head2 check_view_permission

759	765	=cut
760	766
761	767	sub check_view_permission {
762		my $c = shift;
763
764		return 1 unless $c->pref('check_permission_on_view');
765
766		my $user;
767		if ( $c->user_exists() ) {
768		$user = $c->user->obj;
769		}
770
771		$c->log->info('Checking permissions') if $c->debug;
772
773		my $perms = $c->check_permissions( $c->stash->{path}, $user );
774		if ( !$perms->{view} ) {
775		$c->stash->{message}
776		= $c->loc( 'Permission Denied to view x', $c->stash->{page}->name );
777		$c->stash->{template} = 'message.tt';
778		return;
779		}
780
781		return 1;
	768	my $c = shift;
	769
	770	return 1 unless $c->pref('check_permission_on_view');
	771
	772	my $user;
	773	if ($c->user_exists()) {
	774	$user = $c->user->obj;
	775	}
	776
	777	$c->log->info('Checking permissions') if $c->debug;
	778
	779	my $perms = $c->check_permissions($c->stash->{path}, $user);
	780	if (!$perms->{view}) {
	781	$c->stash->{message}
	782	= $c->loc('Permission Denied to view x', $c->stash->{page}->name);
	783	$c->stash->{template} = 'message.tt';
	784	return;
	785	}
	786
	787	return 1;
782	788	}
783	789
784	790	my $search_setup_failed = 0;
785	791
786		MojoMojo->config->{index_dir} \|\|= MojoMojo->path_to('index');
	792	MojoMojo->config->{index_dir} \|\|= MojoMojo->path_to('index');
787	793	MojoMojo->config->{attachment_dir} \|\|= MojoMojo->path_to('uploads');
788		MojoMojo->config->{root} \|\|= MojoMojo->path_to('root');
	794	MojoMojo->config->{root} \|\|= MojoMojo->path_to('root');
789	795	unless (-e MojoMojo->config->{index_dir}) {
790		if (not mkdir MojoMojo->config->{index_dir}) {
791		warn 'Could not make index directory <'.MojoMojo->config->{index_dir}.'> - FIX IT OR SEARCH WILL NOT WORK!';
792		$search_setup_failed = 1;
793		}
	796	if (not mkdir MojoMojo->config->{index_dir}) {
	797	warn 'Could not make index directory <'
	798	. MojoMojo->config->{index_dir}
	799	. '> - FIX IT OR SEARCH WILL NOT WORK!';
	800	$search_setup_failed = 1;
	801	}
794	802	}
795	803	unless (-w MojoMojo->config->{index_dir}) {
796		warn 'Require write access to index <'.MojoMojo->config->{index_dir}.'> - FIX IT OR SEARCH WILL NOT WORK!';
797		$search_setup_failed = 1;
	804	warn 'Require write access to index <'
	805	. MojoMojo->config->{index_dir}
	806	. '> - FIX IT OR SEARCH WILL NOT WORK!';
	807	$search_setup_failed = 1;
798	808	}
799	809
800	810	MojoMojo->model('Search')->prepare_search_index()
801		if not -f MojoMojo->config->{index_dir}.'/segments' and not $search_setup_failed and not MojoMojo->pref('disable_search');
	811	if not -f MojoMojo->config->{index_dir} . '/segments'
	812	and not $search_setup_failed
	813	and not MojoMojo->pref('disable_search');
802	814
803	815	unless (-e MojoMojo->config->{attachment_dir}) {
804		mkdir MojoMojo->config->{attachment_dir}
805		or die 'Could not make attachment directory <'.MojoMojo->config->{attachment_dir}.'>';
806		}
807		die 'Require write access to attachment_dir: <'.MojoMojo->config->{attachment_dir}.'>'
808		unless -w MojoMojo->config->{attachment_dir};
	816	mkdir MojoMojo->config->{attachment_dir}
	817	or die 'Could not make attachment directory <'
	818	. MojoMojo->config->{attachment_dir} . '>';
	819	}
	820	die 'Require write access to attachment_dir: <'
	821	. MojoMojo->config->{attachment_dir} . '>'
	822	unless -w MojoMojo->config->{attachment_dir};
809	823
810	824	1;
811	825

-8

mojomojo.conf less more

27	27	<connect_info>
28	28
29	29	# DB User
30		user db_user
31		password db_password
	30	#user db_user
	31	#password db_password
32	32
33	33	# SQLite dsn (default data store)
34	34	dsn dbi:SQLite:mojomojo.db
35	35
36	36	# Enable unicode for supported databases
37	37	sqlite_unicode 1
38		mysql_enable_utf8 1
39		pg_enable_utf8 1
	38	#mysql_enable_utf8 1
	39	#pg_enable_utf8 1
40	40
41	41	</connect_info>
42	42	</Model::DBIC>
43	43
44		root __path_to(root)__
45		static_path /.static/
46		attachment_dir __path_to(uploads)__
47		index_dir __path_to(index)__
	44	#root __path_to(root)__
	45	#static_path /.static/
	46	attachment_dir ./uploads
	47	#index_dir __path_to(index)__
48	48
49	49	<session>
50	50	expires 604800

-1

root/forms/user/register.yml less more

53	53	constraints:
54	54	- Required
55	55	- type: Regex
56		regex: mojomojo
	56	regex: mojomojo\|catalyst
57	57	message_loc: Go away spammer!
58	58	- type: Submit
59	59	name: submit

-2

script/mojomojo.psgi less more

2	2	use warnings;
3	3	use MojoMojo;
4	4
5		MojoMojo->setup_engine('PSGI');
6		my $app = sub { MojoMojo->run(@_) };
	5	my $app = MojoMojo->psgi_app(@_);
7	6

-1

t/c/image.t less more

0		#!/usr/bin/perl -w
	0	#!/usr/bin/perl
1	1	use Test::More tests => 4;
2	2	BEGIN{
3	3	$ENV{CATALYST_CONFIG} = 't/var/mojomojo.yml';

-1

t/formatter_dir.t less more

0		#!/usr/bin/perl -w
	0	#!/usr/bin/perl
1	1	use strict;
2	2	use MojoMojo::Formatter::Dir;
3	3	use Test::More;

-2

t/formatter_file.t less more

0		#!/usr/bin/perl -w
	0	#!/usr/bin/perl
1	1	use strict;
2	2	use warnings;
3	3	use Test::More;

47	47	# Check good text file
48	48	$content = "<p>{{file Text $dir/test.txt}}</p>";
49	49	$ret = MojoMojo::Formatter::File->format_content(\$content, $c);
50		like($$ret, qr{<div class="formatter_txt">\n<p>Text file</p> <p><a href="http://mojomojo.org/">http://mojomojo.org</a></p></div>}s, "Text file is formated");
	50	like($$ret, qr{<div class="formatter_txt">\n<p>Text file</p> <p><a href="http://mojomojo.org">http://mojomojo.org</a></p></div>}s, "Text file is formated");
51	51
52	52	# check checkfile with file not include in whitelist
53	53	$ret = MojoMojo::Formatter::File->checkfile("/etc/passwd", $c);

+12

-12

t/formatter_include.t less more

8	8	BEGIN {
9	9	plan skip_all => 'Requirements not installed for the Include formatter'
10	10	unless MojoMojo::Formatter::Include->module_loaded;
11		plan tests => 7;
	11	plan tests => 2;
12	12	$ENV{CATALYST_CONFIG} = 't/var/mojomojo.yml';
13	13	use_ok('Catalyst::Test', 'MojoMojo');
14	14	}

16	16	my $fake_c = FakeCatalystObject->new;
17	17	my ($content);
18	18
19		content_like('/.jsrpc/render?content=%7B%7Bhttp://localhost/help%7D%7D', qr'{{http://localhost/help}}',
20		'invalidate the old "syntax"');
	19	#content_like('/.jsrpc/render?content=%7B%7Bhttp://localhost/help%7D%7D', qr'{{http://localhost/help}}',
	20	# 'invalidate the old "syntax"');
21	21
22	22	# match against the start of the string, \A, to make sure no page cruft gets included besides the content
23		content_like('/.jsrpc/render?content=%7B%7Binclude http://localhost/help%7D%7D', qr/\A<h1>Help/,
24		'include part of wiki, absolute URL');
25		content_like('/.jsrpc/render?content=%7B%7Binclude /help%7D%7D', qr/\A<h1>Help/,
26		'include part of wiki, relative URL');
	23	#content_like('/.jsrpc/render?content=%7B%7Binclude http://localhost/help%7D%7D', qr/\A<h1>Help/,
	24	# 'include part of wiki, absolute URL');
	25	#content_like('/.jsrpc/render?content=%7B%7Binclude /help%7D%7D', qr/\A<h1>Help/,
	26	# 'include part of wiki, relative URL');
27	27
28		content_like('/help.jsrpc/render?content=%7B%7Binclude http://localhost/%7D%7D', qr/\A<h1>Welcome\sto\sMojoMojo/,
29		'include the root page, absolute URL');
30		content_like('/help.jsrpc/render?content=%7B%7Binclude /%7D%7D', qr/\A<h1>Welcome\sto\sMojoMojo/,
31		'include the root page, relative URL');
	28	#content_like('/help.jsrpc/render?content=%7B%7Binclude http://localhost/%7D%7D', qr/\A<h1>Welcome\sto\sMojoMojo/,
	29	# 'include the root page, absolute URL');
	30	#content_like('/help.jsrpc/render?content=%7B%7Binclude /%7D%7D', qr/\A<h1>Welcome\sto\sMojoMojo/,
	31	# 'include the root page, relative URL');
32	32
33	33	SKIP: {
34	34	skip "set TEST_LIVE to run tests that requires a live Internet connection", 1
35	35	if not $ENV{TEST_LIVE};
36	36
37		$content = "{{include http://github.com/marcusramberg/mojomojo/raw/85605d55158b1e6380457d4ddc31e34b7a77875a/Changes}}\n";
	37	$content = "{{include http://github.com/mojomojo/mojomojo/raw/85605d55158b1e6380457d4ddc31e34b7a77875a/Changes}}\n";
38	38	MojoMojo::Formatter::Include->format_content(\$content, $fake_c, undef);
39	39	like($content, qr{0\.999001\s+2007\-08\-29\s16\:29\:00}, 'include Changes file from GitHub');
40	40	}

-1

t/special-page.t less more

0		#!/usr/bin/perl -w
	0	#!/usr/bin/perl
1	1	use Test::More;
2	2	BEGIN {
3	3	$ENV{CATALYST_CONFIG} = 't/var/mojomojo.yml';