SUPER:: results from the CPAN

SUPER::

Apache-SWIT

view release on metacpan or search on metacpan

lib/Apache/SWIT/HTPage/Safe.pm view on Meta::CPAN

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

package Apache::SWIT::HTPage::Safe;
use base 'Apache::SWIT::HTPage';
use Carp;

sub swit_render {
	my ($class, $r) = @_;
	my $stash = $class->SUPER::swit_render($r);
	my $es = $r->param('swit_errors') or goto OUT;
	$class->ht_root_class->ht_error_render($stash, 'swit_errors', $es);
OUT:
	return $stash;
}

sub _encode_errors {
	return shift()->swit_encode_errors(@_);
}

lib/Apache/SWIT/HTPage/Safe.pm view on Meta::CPAN

	my %cols = map { ($_, 1) } split(/, /, $iargs);
	my @errs = map { [ $_->[1], "unique" ] } grep { $cols{$_->[0]} }
		map { [ ($_->options->{cdbi_bind} || $_->options->{safe_bind}
				|| $_->name), $_->name ] }
		grep { exists($_->options->{cdbi_bind})
				|| exists($_->options->{safe_bind}) }
			@{ $root->Widgets_List };
	return $class->swit_encode_errors(\@errs);

ORIG_ERROR:
	return shift()->SUPER::ht_swit_update_die(@_);
}

1;

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

			, "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 {

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


package Apache::SWIT::Maker::FileWriter;
use base 'Class::Data::Inheritable', 'Class::Accessor';
use Template;
use File::Slurp;

__PACKAGE__->mk_classdata('Files', {});
__PACKAGE__->mk_accessors(qw(root_dir));

sub new {
	my $self = shift()->SUPER::new(@_);
	$self->{root_dir} ||= '.';
	return $self;
}

sub _normalize_options {
	my ($self, $orig_opts, $new_opts) = @_;
	my %res = map { $_, 
		exists($new_opts->{$_}) ? $new_opts->{$_} : $orig_opts->{$_}
	} (keys(%$orig_opts), keys(%$new_opts));
	if (my $c = $res{class}) {

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


__PACKAGE__->root_location('[% root_location %]');
__PACKAGE__->make_aliases(
[% aliases %]
);

sub new {
	my ($class, $args) = @_;
	$args->{session_class} = '[% httpd_session_class %]'
		unless exists($args->{session_class});
	return $class->SUPER::new($args);
}

1;
EM

__PACKAGE__->add_file({ name => 'test', manifest => 1 }, <<'EM');
use strict;
use warnings FATAL => 'all';

use Test::More tests => [% plan %];

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

	my $gclasses = $args->{generator_classes} ? 
			$args->{generator_classes} : $tree->{generators};
	my @gens;
	for my $c (@$gclasses) {
		eval "use $c";
		die "Unable to use $c : $@" if $@;
		push @gens, $c->new;
	}
	$args = { generators => \@gens };
OUT:	
	return $class->SUPER::new($args);
}

sub run {
	my ($self, $func, @args) = @_;
	my $res;
	for my $g (@{ $self->generators }) {
		next unless $g->can($func);
		$res = $g->$func($res, @args);
	}
	return $res;

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

}

sub _init_dirscan {
	my $self = shift;
	my $bf = $self->blib_filter || $self->can('_Blib_Filter');
	my $fs = ExtUtils::Manifest::maniread();
	my @files = grep { $bf->($_); } keys %$fs;
	return unless @files;
	$self->overrides->{const_config} = sub {
		my $this = shift;
		my $res = $this->MY::SUPER::const_config(@_);
		$this->{PM}->{$_} = "blib/$_" for @files;
		return $res;
	};
}

sub _mm_install {
	return <<ENDS;
install :: all
	./scripts/swit_app.pl install \$(INSTALLSITELIB)
ENDS
}

sub _mm_constants {
	my $str = shift()->MY::SUPER::constants(\@_);
	my $an = Apache::SWIT::Maker::Config->instance->app_name;
	my $rep = "INSTALLSITELIB=\$(SITEPREFIX)/share/$an";
	$str =~ s#INSTALLSITELIB[^\n]+#$rep#;
	return $str;
}

sub _mm_test {
	my $res = shift()->MY::SUPER::test(@_);
	if ($<) {
		$res =~ s/PERLRUN\)/PERLRUN) -I t\//g;
	} else {
		my $cmd = "./scripts/swit_app.pl test_root test";
		$res =~ s#\$\(FULLPERLRUN\).*#$cmd#;
		$res =~ s#test_ : .*#test_ :\n\t$cmd\_#;
	}
	return $res;
}

lib/Apache/SWIT/Subsystem/Makefile.pm view on Meta::CPAN


package Apache::SWIT::Subsystem::Makefile;
use base 'Apache::SWIT::Maker::Makefile';
use Apache::SWIT::Maker::GeneratorsQueue;
use Apache::SWIT::Maker::Manifest;
use Apache::SWIT::Maker::Config;
use File::Slurp;
use Data::Dumper;

sub write_makefile {
	shift()->SUPER::write_makefile(@_);
	my $mf = read_file('Makefile');
	my $df = join(" ", swmani_dual_tests());
	Apache::SWIT::Maker::Config->instance->for_each_url(sub {
		my ($uri, $n, $v, $ev) = @_;
		$df .= " " . $ev->{template} if $ev->{template};
	});
	$mf =~ s/%IC_TEST_FILES%/$df/;
	write_file('Makefile', $mf);
}

lib/Apache/SWIT/Subsystem/Makefile.pm view on Meta::CPAN

			{ name => $_, 'dump' => Dumper($dumps{$_}) }
	} keys %dumps ] });
}

sub do_install {
	my ($class, $from, $to) = @_;
	$class->install_files("$from/lib", $to);
}

sub _mm_constants {
	return shift()->MY::SUPER::constants(\@_);
}

1;

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

sub write_maker_pm {
	my $self = shift;
	my $c = Apache::SWIT::Maker::Config->instance->root_class . "::Maker";
	swmani_write_file("lib/" . conv_class_to_file($c)
		, conv_module_contents($c, <<ENDM));
use base 'Apache::SWIT::Subsystem::Maker';
ENDM
}

sub available_commands {
	my %res = shift()->SUPER::available_commands(@_);
	$res{installation_content} = [ 'Write InstallationContent.pm' ];
	return %res;
}

sub write_initial_files {
	my $self = shift;
	$self->SUPER::write_initial_files(@_);
	$self->write_950_install_t;
	$self->write_maker_pm;

	my $mr = YAML::LoadFile('conf/makefile_rules.yaml');
	my $rc = Apache::SWIT::Maker::Config->instance->root_class;
	my $icf = "blib/lib/".conv_class_to_file($rc."::InstallationContent");
	push @{ $mr->[0]->{dependencies} }, $icf;
	push @$mr, { targets => [ $icf ], dependencies => [ 'conf/swit.yaml'
			, '%IC_TEST_FILES%' ]
		, actions => [ './scripts/swit_app.pl installation_content' ]
	};
	YAML::DumpFile('conf/makefile_rules.yaml', $mr);
}

sub add_class {
	my ($self, $new_class, $str) = @_;
	$self->SUPER::add_class($new_class, $str);
	Apache::SWIT::Maker::Config->instance->add_startup_class($new_class);
}

sub write_swit_yaml {
	my $gens = Apache::SWIT::Maker::Config->instance->generators;
	push @$gens, 'Apache::SWIT::Subsystem::Generator';
	shift()->SUPER::write_swit_yaml;
}

sub install_subsystem {
	my ($self, $module) = @_;
	my $lcm = lc($module);
	my $rc = Apache::SWIT::Maker::Config->instance->root_class;
	my $full_name =  $rc . '::' . $module;

	my $orig_tree = $self->this_subsystem_original_tree;
	my $gq = Apache::SWIT::Maker::GeneratorsQueue->new({

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

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

package Apache::SWIT::Template;
use base 'Template';

sub new {
	my ($self, $args) = @_;
	$args ||= { ABSOLUTE => 1, INCLUDE_PATH => ($INC[0] . "/..") };
	return $self->SUPER::new($args) or die "Unable to create template";
}

sub preload_all {
	my @tts = map { chomp; $_; } `find $INC[0]/../templates/ -name "*.tt"`;
	@tts = map { s#^.*\.\./(templates.*)#$1#; $_ } @tts;
	chdir('/');
	$Apache::SWIT::TEMPLATE->context->template($_) for @tts;
	chdir($INC[0] . "/../../");
}

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

use base 'WWW::Mechanize';
use Encode::Guess;

sub reload {
	my $self = shift;
	$self->get($self->uri);
}

sub redirect_ok {
	my $self = shift;
	return $self->max_redirect ? $self->SUPER::redirect_ok(@_) : undef;
}

package Apache2::Request;
sub new { return $_[1]; }

package Apache::SWIT::Test;
use base 'Class::Accessor', 'Class::Data::Inheritable';
use Apache::SWIT::Maker::Conversions;
use Apache::SWIT::Test::Utils;
use Apache::SWIT::Test::Request;

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

	_Do_Startup("blib/conf/do_swit_startups.pl");
}

sub new {
	my ($class, $args) = @_;
	$args ||= {};
	if ($ENV{SWIT_HAS_APACHE}) {
		$args->{mech} = Apache::SWIT::Test::Mechanize->new;
	}
	$args->{session} = $args->{session_class}->new;
	my $self = $class->SUPER::new($args);
	$self->root_location("") unless $self->root_location;
	$self->_setup_session(Apache::SWIT::Test::Request->new({
		uri => $self->root_location . "/" }), url_to_make => "");
	return $self;
}

sub new_guitest {
	my $self = shift()->new(@_);
	if ($self->mech) {
		$ENV{MOZ_NO_REMOTE} = 1;

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

sub run_tests {
	my $res = 0;
	ASTU_Mem_Show("Apache memory before");
	$ENV{APACHE_SWIT_SERVER_URL} = "http://" . Apache::TestRequest::hostport . "/";
	delete $ENV{APACHE_TEST_PORT};
	if ($ENV{__APACHE_SWIT_RUN_SERVER__}) {
		print STDERR "# Server url is $ENV{APACHE_SWIT_SERVER_URL}\n";
		print STDERR "# Press Enter to finish ...\n";
		readline(\*STDIN);
	} else {
		$res = shift()->SUPER::run_tests(@_);
	}
	ASTU_Mem_Show("Apache memory after");
	return $res;
}

sub configure {
	shift()->SUPER::configure(@_);
	$ENV{APACHE_SWIT_SERVER_URL} = "http://" . Apache::TestRequest::hostport . "/";
	my $cf = read_file('t/conf/httpd.conf');
	$cf =~ s/TransferLog/#/g;
	if ($ENV{APACHE_SWIT_PROFILE}) {
		mkdir 't/logs';
		my $abs = abs_path('t/logs');
		$cf .= <<ENDS;
PerlSetEnv NYTPROF file=$abs/nytprof
PerlModule Devel::NYTProf::Apache
MaxClients 1

lib/Apache/SWIT/Test/ModuleTester.pm view on Meta::CPAN

use Test::TempDatabase;

__PACKAGE__->mk_accessors(qw(root_dir root_class install_dir project_class
			subsystem_name no_cleanup));

sub new {
	delete $ENV{TEST_FILES};
	delete $ENV{MAKEFLAGS};
	delete $ENV{MAKEOVERRIDES};

	my $self = shift()->SUPER::new(@_);
	$self->root_dir(tempdir("/tmp/" . basename($0) 
				. "_XXXXXX", CLEANUP => $self->no_cleanup ? 0 : 1))
		unless $self->root_dir;
	return $self;
}

sub run_modulemaker {
	my $rc = shift()->root_class;
	undef $Apache::SWIT::Maker::Config::_instance;
	`modulemaker -I -n $rc`;

t/545_session.t view on Meta::CPAN

BEGIN { use_ok('Apache::SWIT::Test::ModuleTester'); }

my $mt = Apache::SWIT::Test::ModuleTester->new({ root_class => 'TTT' });
chdir $mt->root_dir;
$mt->make_swit_project;
ok(-f 'LICENSE');

$mt->replace_in_file('lib/' . $mt->module_dir . "/Session.pm", '1', <<'ENDM');
sub access_handler {
	my ($class, $r) = @_;
	my $res = $class->SUPER::access_handler($r);
	return ($r->pnotes('SWITSession')->get_deny && $r->uri !~ qr/index/)
			? Apache2::Const::FORBIDDEN() : $res;
}

__PACKAGE__->add_var($ENV{KOOKOO_VAR});

1;
ENDM

$mt->replace_in_file('lib/TTT/UI/Index.pm', "return \\\"", <<'ENDM');

t/560_ht_seal.t view on Meta::CPAN

		write_file('curf', $curf);
		isnt(-f 'curf', undef);
	}
});

package M;
use base 'WWW::Mechanize';

sub get {
	Test::More::diag("MGET");
	shift()->SUPER::get(@_);
}

package main;

$t->mech(M->new) if $t->mech;
$t->ok_get('www/main.css');
ENDS

append_file('t/dual/001_load.t', <<'ENDS');
if ($t->mech) {

t/T/HTError.pm view on Meta::CPAN


sub ht_swit_validate_die {
	my ($class, $errs, $r, $root) = @_;
	my $res = $root->name eq 'foo' ? "r?error=validate"
			: "r?error=validie&error_uri=" . $r->uri;
	return ($res, 'password');
}

sub ht_swit_update_die {
	my ($class, $msg, $r, $root) = @_;
	return $class->SUPER::swit_die(@_) unless $msg =~ /Hoho/;
	return ("r?error=updateho", "password");
}

sub ht_swit_update {
	my ($class, $r, $root) = @_;
	return [ Apache2::Const::FORBIDDEN() ] if $root->name eq 'FORBID';
	return $class->swit_failure('r?error=failure', 'password')
		if $root->name eq 'fail';
	die "Hoho";
	return "r";

t/T/HTInherit.pm view on Meta::CPAN

use warnings FATAL => 'all';

package T::HTInherit::Root;
use base 'T::HTPage::Root';

__PACKAGE__->ht_add_widget(::HTV."::Marked", 'inhe_val');

sub ht_render {
	my ($self, $stash, $req) = @_;
	$self->inhe_val($req->param('inhe'));
	$self->SUPER::ht_render($stash, $req);
}

package T::HTInherit;
use base 'T::HTPage';

1;

t/T/Invalid.pm view on Meta::CPAN

package T::Invalid;
use base 'Apache::SWIT';

sub swit_invalid_request {
	my ($class, $r) = @_;
	return [ Apache2::Const::OK, qr/Invalid handler called/ ];
}

sub _raw_respond {
	my ($class, $r, $to) = @_;
	return $class->SUPER::_raw_respond($r->{req}, $to);
}

sub invalid_handler($$) {
	my ($class, $r) = @_;
	return $class->swit_update_handler({ req => $r });
}

1;

t/T/Safe.pm view on Meta::CPAN

		$dbh->do("insert into another_t (name) values ('fff')");
	}
	$root->cdbi_create;
	return $root->ht_make_query_string("r", "s_id");
}

sub ht_swit_update_die {
	my ($class, $msg, $r, $root) = @_;
	return $msg =~ /CUSTOM/ ?
		$class->swit_encode_errors([ [ "name", 'custom' ] ])
	                        : shift()->SUPER::ht_swit_update_die(@_);
}

1;

t/T/SessPage.pm view on Meta::CPAN

use base 'Apache::SWIT::HTPage';
use HTML::Tested qw(HTV);

sub swit_startup {
	shift()->ht_make_root_class->ht_add_widget(HTV."::EditBox", 'persbox');
}

sub swit_process_template {
	my ($class, $r, $file, $vars) = @_;
	$vars->{moo} = 'moo is foo';
	return shift()->SUPER::swit_process_template(@_);
}

sub ht_swit_render {
	my ($class, $r, $root) = @_;
	$root->persbox($r->pnotes('SWITSession')->get_persbox);
	return $root;
}

sub ht_swit_update {
	my ($class, $r, $root) = @_;

t/T/Session.pm view on Meta::CPAN

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

package T::Session;
use base 'Apache::SWIT::Session';

__PACKAGE__->add_var('persbox');

sub access_handler {
	my ($class, $r) = @_;
	my $res = $class->SUPER::access_handler($r);
	return ($r->pnotes('SWITSession')->get_persbox && $r->uri =~ /\.html/)
			? Apache2::Const::FORBIDDEN() : $res;
}

sub cookie_name { return 'foo' }

1;

t/T/Test.pm view on Meta::CPAN

package T::Test;
use base 'Apache::SWIT::Test';
use Apache::SWIT::Session;

BEGIN { __PACKAGE__->do_startup; };

sub new {
	my ($class, $args) = @_;
	$args->{session_class} = 'Apache::SWIT::Session'
		unless exists($args->{session_class});
	return $class->SUPER::new($args);
}

1;

t/T/Upload.pm view on Meta::CPAN

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

package T::Upload::Image;
use base 'HTML::Tested::Value::Upload';

sub absorb_one_value {
	my ($self, $root, $val, @path) = @_;
	return unless $val->size;
	$self->SUPER::absorb_one_value($root, $val, @path);
}

package T::Upload::DB;
use base 'Apache::SWIT::DB::Base';
__PACKAGE__->set_up_table('upt');

package T::Upload::Root;
use base 'HTML::Tested::ClassDBI';
use HTML::Tested qw(HTV);

( run in 1.521 second using v1.01-cache-2.11-cpan-49f99fa48dc )