view release on metacpan or  search on metacpan

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

=head1 NAME

Apache::SWIT::Maker - creates various skeleton files for your SWIT project.

=head1 METHODS

=cut
use strict;
use warnings FATAL => 'all';

package Apache::SWIT::Maker;
use base 'Class::Accessor';
use File::Path;
use File::Basename qw(dirname basename);
use File::Copy;
use Crypt::CBC;
use Cwd qw(abs_path getcwd);
use Apache::SWIT::Maker::GeneratorsQueue;
use Apache::SWIT::Maker::FileWriterData;
use Apache::SWIT::Maker::Conversions;
use Apache::SWIT::Maker::Config;
use Apache::SWIT::Maker::Makefile;
use File::Slurp;
use Digest::MD5 qw(md5_hex);
use Apache::SWIT::Maker::Manifest;
use ExtUtils::Manifest qw(maniread manicopy);
use File::Temp qw(tempdir);
use Data::Dumper;

__PACKAGE__->mk_accessors(qw(file_writer));

my @_initial_skels = qw(apache_test apache_test_run dual_001_load startup);

sub _load_skeleton {
	my ($class, $skel_class, $func) = @_;
	my $s = 'Apache::SWIT::Maker::Skeleton::' . $skel_class;
	conv_eval_use($s);

	no strict 'refs';
	*{ __PACKAGE__ . "::$func" } = sub { return $s; }
		unless __PACKAGE__->can($func);
}

__PACKAGE__->_load_skeleton(conv_table_to_class($_), $_) for @_initial_skels;

my %_page_skels = (qw(skel_page Page skel_template Template
		skel_ht_page HT::Page skel_ht_template HT::Template
		skel_db_class DB::Class scaffold_dual_test Scaffold::DualTest)
		, map { ("scaffold_".lc($_), "Scaffold::$_"
			, "scaffold_".lc($_)."_template"
			, "Scaffold::$_"."Template") } qw(List Form Info));

while (my ($n, $v) = each %_page_skels) {
	__PACKAGE__->_load_skeleton($v, $n);
}

sub makefile_class { return 'Apache::SWIT::Maker::Makefile'; }

sub new {
	my $self = shift->SUPER::new(@_);
	$self->{file_writer} ||= Apache::SWIT::Maker::FileWriterData->new;
	return $self;
}

sub schema_class {
	return Apache::SWIT::Maker::Config->instance->root_class
		. '::DB::Schema';
}

sub write_swit_yaml {
	swmani_write_file('conf/swit.yaml', "");
	Apache::SWIT::Maker::Config->instance->save;
}

sub write_makefile_pl {
	my $self = shift;

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

}

sub write_session_pm {
	my $self = shift;
	my $an = Apache::SWIT::Maker::Config->instance->app_name;
	$self->add_class(Apache::SWIT::Maker::Config->instance
			->session_class, <<ENDM);
use base 'Apache::SWIT::Session';

sub cookie_name { return '$an'; }

ENDM
}

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';
}