view release on metacpan or  search on metacpan

lib/Apache/SWIT/Maker.pm  view on Meta::CPAN

sub write_db_schema_file {
	my $self = shift;
	my $an = Apache::SWIT::Maker::Config->instance->app_name;
	swmani_write_file("lib/" . conv_class_to_file($self->schema_class)
			, conv_module_contents($self->schema_class, <<ENDM));
use base 'DBIx::VersionedSchema';
__PACKAGE__->Name('$an');

__PACKAGE__->add_version(sub {
	my \$dbh = shift;
});

ENDM
}

sub write_test_db_file {
	swmani_write_file('t/T/TempDB.pm', sprintf(<<'ENDS'
package T::TempDB;
use Apache::SWIT::Test::DB;
Apache::SWIT::Test::DB->setup('%s_test_db', '%s');
1;
ENDS
	, Apache::SWIT::Maker::Config->instance->app_name
	, shift()->schema_class));
}

sub write_t_extra_conf_in {
	my $self = shift;
	my $an = Apache::SWIT::Maker::Config->instance->app_name;
	swmani_write_file('t/conf/extra.conf.in', <<ENDM);
PerlPassEnv APACHE_SWIT_DB_NAME
PerlPassEnv APACHE_SWIT_SERVER_URL
LogLevel notice
<IfModule mod_mime.c>
	Include "/etc/apache2/mods-enabled/mime.conf"
</IfModule>
Include ../blib/conf/httpd.conf
CustomLog logs/access_log switlog
<Location />
	PerlInitHandler Apache::SWIT::Test::ResetKids->access_handler
</Location>
ENDM
}

sub write_seal_key {
	swmani_write_file("conf/seal.key"
		, md5_hex(Crypt::CBC->random_bytes(8)));
}

sub write_httpd_conf_in {
	my $self = shift;
	my $rl = Apache::SWIT::Maker::Config->instance->root_location;
	my $an = Apache::SWIT::Maker::Config->instance->app_name;
	swmani_write_file('conf/httpd.conf.in', <<ENDM);
RewriteEngine on
RewriteRule ^/\$ $rl/index/r [R]
Alias $rl/www \@ServerRoot\@/public_html 
Alias /html-tested-javascript /usr/local/share/libhtml-tested-javascript-perl
# Format is:
# Remote IP, time, request, status, duration, referer, user agent
# PID, Cookie, total bytes in request, total bytes in response
LogFormat "%a %t \\"%r\\" %>s %D \\"%{Referer}i\\" \\"%{User-Agent}i\\" %P %{$an}C %I %O" switlog
ENDM
}

sub add_test {
	my ($self, $file, $number, $content) = @_;
	unless ($number) {
		$number = 1;
		$content = "BEGIN { use_ok('"
			. Apache::SWIT::Maker::Config->instance->root_class
			."'); }";
	}
	swmani_write_file($file, <<ENDT);
use strict;
use warnings FATAL => 'all';

use Test::More tests => $number;

$content
ENDT
}

sub write_010_db_t {
	shift()->add_test('t/010_db.t', 1, <<ENDM);
use T::TempDB;

package T::DBI;
use base 'Apache::SWIT::DB::Base';
__PACKAGE__->table('test_table');
__PACKAGE__->columns(Essential => qw/a b/);

package main;
Apache::SWIT::DB::Connection->instance->db_handle->do(
		"create table test_table (a integer, b text)");
is_deeply([ T::DBI->retrieve_all ], []);

ENDM
}

sub write_swit_app_pl {
	my $self = shift;
	$self->file_writer->write_scripts_swit_app_pl({
				class => ref($self) });
	chmod 0755, 'scripts/swit_app.pl';
}

sub install {
	my ($self, $inst_dir) = @_;
	my $si = Apache::SWIT::Maker::Config->instance->{skip_install} || [];
	my %skips = map {
		my $v = read_file($_) or die "Nothing for $_";
		($_, $v);
	} map { "blib/$_" } @$si;
	unlink($_) for keys %skips;
	$self->makefile_class->do_install("blib", $inst_dir);
	write_file($_, $skips{$_}) for keys %skips;
}

sub write_initial_files {
	my $self = shift;

lib/Apache/SWIT/Maker.pm  view on Meta::CPAN

	system("pg_dump -c $ENV{APACHE_SWIT_DB_NAME} > t/conf/schema.sql");
}

sub _make_page {
	my ($self, $page_class, $args, @funcs) = @_;
	my $i = Apache::SWIT::Maker::Config->instance;
	my $e = $i->create_new_page($page_class);
	for my $f (@funcs) {
		my $p = $self->$f->new($args);
		$p->config_entry($e);
		$p->write_output;
	}
	$i->save;
	return $e;
}

=head2 add_page(page)

Adds page and related files. Page should be the name of the module, 
e.g. 'Index'. See C<add_ht_page> for adding HTML::Tested enabled page.

=cut
sub add_page {
	my ($self, $pc) = @_;
	return $self->_make_page($pc, {}, qw(skel_template skel_page));
}

=head2 add_ht_page(page)

Adds HTML::Tested enabled page and related files. 
Page should be the name of the module, e.g. 'Index'.

=cut
sub add_ht_page {
	my ($self, $pc) = @_;
	return $self->_make_page($pc, {}, qw(skel_ht_template skel_ht_page));
}

sub _location_section_start {
	my ($self, $l, $c, $h) = @_;
return <<ENDS
<Location $l>
	SetHandler perl-script
	PerlHandler $c\->$h
ENDS
}

sub gen_conf_header {
	return <<ENDS;
<IfModule !apreq_module.c>
	LoadModule apreq_module /usr/lib/apache2/modules/mod_apreq2.so
</IfModule>
<IfModule !rewrite_module.c>
	LoadModule rewrite_module /usr/lib/apache2/modules/mod_rewrite.so
</IfModule>
<IfModule !mod_deflate.c>
	LoadModule deflate_module /usr/lib/apache2/modules/mod_deflate.so
</IfModule>
AddOutputFilterByType DEFLATE text/html text/plain text/xml text/css application/x-javascript application/javascript application/xhtml+xml image/svg+xml

PerlModule Apache2::Request Apache2::Cookie Apache2::Upload Apache2::SubRequest
ENDS
}

sub regenerate_httpd_conf {
	my $self = shift;
	my $gq = Apache::SWIT::Maker::GeneratorsQueue->new;
	my $tree = Apache::SWIT::Maker::Config->instance;
	my ($sc, $rl) = ($tree->{session_class}, $tree->{root_location});
	my $ht_in = $self->gen_conf_header . <<ENDS;
PerlPostConfigRequire \@ServerRoot\@/conf/startup.pl
PerlPostConfigRequire \@ServerRoot\@/conf/do_swit_startups.pl
<Location $rl>
	PerlAccessHandler $sc\->access_handler
	PerlSetVar SWITRootLocation $rl
</Location>
ENDS
	my $evars = $tree->{env_vars} || {};
	my $s = join("\n", map { "\$ENV{$_} = '$evars->{$_}';" } keys %$evars);

	my ($aliases, $spl) = ("", "BEGIN {\n$s\n};\n" . join("\n", map {
		"use $_;\n$_\->swit_startup;"
	} @{ $tree->{startup_classes} || [] }) . "\n");

	$tree->for_each_url(sub {
		my ($url, $pname, $pentry, $ep) = @_; 
		my $res = $gq->run('location_section_prolog', $pname, $pentry);
		$ht_in .= $self->_location_section_start($url, $pentry->{class}
				, $ep->{handler});
		$ht_in .= $gq->run('location_section_contents', $url, $ep);
		$ht_in .= "</Location>\n";

	});
	while (my ($n, $v) = each %{ $tree->{pages} }) {
		$aliases .= "\"$n\" => \"$v->{class}\",\n";
		$spl .= "use $v->{class};\n$v->{class}->swit_startup;\n"
	}

	mkpath_write_file('blib/conf/do_swit_startups.pl', "$spl\n1;\n");

	my $hcstr = $ht_in . $gq->run('httpd_conf_start');
	my $blib = abs_path("blib");
	$hcstr =~ s/\@ServerRoot\@/$blib/g;
	write_file('blib/conf/httpd.conf', $hcstr);

	$self->file_writer->write_t_t_test_pm({
		session_class => $tree->{session_class}
		, root_location => $tree->{root_location}
		, blib_dir => abs_path("blib")
		, aliases => $aliases, httpd_session_class =>
			$tree->{session_class} });
	return $tree;
}

sub remove_file {
	my ($self, $file) = @_;
	swmani_filter_out($file);
	unlink($file);
}

=head2 remove_page(page)