view release on metacpan or  search on metacpan

lib/Apache/SdnFw/lib/Core.pm  view on Meta::CPAN

 $s->notify($msg);

=cut

	my $s = shift;
	my $message = shift;

	if ($s->{employee_id}) {
		my $notify;
		$s->tt('notify.tt', { s => $s, message => $message}, \$notify);
	
		$s->{message} .= $notify;
	}
}

sub run {
	my $s = shift;

	# first we need a database connection but not for our database debug option
	$s->{dbh} = db_connect($s->{env}{DB_STRING},$s->{env}{DB_USER})
		unless($s->{object} eq 'dbdb');

	#get_memd($s);

	# figure out where our base code directory is so we can use templates
	# and other things
	foreach my $i (@INC) {
		if (-d "$i/Apache/SdnFw") {
			$s->{plib} = "$i/Apache/SdnFw";
			last;
		}
	}

	my @path;
	if ($s->{agent}) {
		push @path, "$ENV{HTTPD_ROOT}/$s->{obase}/tt/$s->{agent}";
		push @path, "$ENV{HTTPD_ROOT}/$s->{obase}/object";
		push @path, "$ENV{HTTPD_ROOT}/$s->{obase}/tt";
		push @path, "$s->{plib}/tt/$s->{agent}";
		push @path, "$s->{plib}/tt";
		push @path, "$s->{plib}/object";
	} else {
		push @path, "$ENV{HTTPD_ROOT}/$s->{obase}/object";
		push @path, "$ENV{HTTPD_ROOT}/$s->{obase}/tt";
		push @path, "$s->{plib}/tt";
		push @path, "$s->{plib}/object";
	}
	push @path, "/data/$s->{obase}";
	$s->{tt} = Template->new(
		INCLUDE_PATH => \@path,
		INTERPOLATE => 1,
		RELATIVE => 1,
		EVAL_PERL => 1,
		COMPILE_DIR => '/tmp/tt_cache',
		COMPILE_EXT => '.cache',
		# remove leading and trailing whitespace and newlines
		#PRE_CHOMP => 2,
		#POST_CHOMP => 2,
		#STAT_TTL => 1,
		OUTPUT => \$s->{content},
		);

	#$s->{content} .= "<pre>".Data::Dumper->Dump([$s])."</pre>"; return;
	#$s->{content} .= "<pre>".Data::Dumper->Dump([\@INC])."</pre>"; return;

#	if ($s->{raw_path} eq '/logout') {
#		return unless($s->_authenticate());
#	}

	# if we barf below anywhere we do not want to show anything but the raw error so set this
	$s->{nomenu} = 1; 

	# at this point, we need to look for $object
	# and from there $function
	# and make it into a path that we can then run
	# $object will be things like /objectname
	# or /objectname/function
	# and will only go two levels deep
	@{$s->{path}} = split '/', $s->{raw_path};
	shift @{$s->{path}}; # get rid of the blank due to starting with /
	if (scalar @{$s->{path}} < 1) {
		# set home if we did not explicitly call a object
		push @{$s->{path}}, 'home';
	}

	# make sure we are not trying to call strange stuff
	foreach my $v (@{$s->{path}}) {
		croak "invalid path value '$v'" unless($v =~ m/^[a-z0-9_\.]+$/);
	}

	croak "invalid path (more than 2 keys)" if (scalar @{$s->{path}} > 2);
	$s->{object} = $s->{path}[0];
	$s->{function} = $s->{path}[1] || 'list';

	# this is a stupid hack because I could not create an object called return
	$s->{object} = 'oreturn' if ($s->{object} eq 'return');

	if ($s->{object} eq 'logout') {
		$s->_authenticate();
		$s->{function} = 'home' if ($s->{function} eq 'list');
		$s->redirect(object => $s->{function},
			function => 'list');
		return;
	}

	if ($s->{env}{DEV} && $s->{object} eq 'debug') {
		$s->{content} = Data::Dumper->Dump([$s]);
		$s->{content_type} = 'text/plain';
		return;
	}

	no strict 'refs';
	if ($s->{object} ne 'help') {
		$s->{obj_base} = $s->{obase}.'::object::'.$s->{object};
		my $config = $s->{obj_base}.'::config';
	
		# make sure we can find the object
		unless(defined(&{$config})) {
			# see if there is a generic object defined
			$s->{obj_base} = 'Apache::SdnFw::object::'.$s->{object};