view release on metacpan or  search on metacpan

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

		if ($s->{employee}{admin} && !($s->{object} =~ m/^(me|help)$/)) {
			$s->{employee}{object}{$s->{object}}{permission} = 1;
			(my $args = $s->{args}) =~ s/=/%3D/g;
			$s->add_action(function => 'permission',
				params => "return=$s->{function}&return_args=".$s->escape($args)) 
				unless($s->{env}{HIDE_PERMISSION} || $s->{agent});
		}

		# if we are in autocommit still at this point
		# then it probably means there was an error, so we need
		# to rollback before we can do this query below
		if ($s->{dbh}->{AutoCommit} == 0) {
			$s->{dbh}->rollback;
		}

		# load tabs
		@{$s->{tabs}} = $s->db_q("
			SELECT code, COALESCE(tab_name, name) as name
			FROM objects
			WHERE tab_order IS NOT NULL
			ORDER BY tab_order
			",'arrayhash');

		my $menu;
		$s->tt($s->{o}{menutemplate} || 'menu.tt', { s => $s }, \$menu);
		return $menu;
	}
}

sub _head_add_css {
	my $s = shift;

	return if ($s->{no_css});

	my $stylefile = 'style';
	if ($s->{agent}) {
		$stylefile = "$s->{agent}/$stylefile";
	}

	# in order to help with load times, just include the css directly
	# instead of having them call the request the file separatly
	my $sfile = "/data/$s->{obase}/content/css/$stylefile.css"; 

	# if our object has a specific style file, then use that instead
	$sfile = "/code/$s->{obase}/css/$s->{o}{css}.css" if ($s->{o}{css});


	my $return;
	if (-e $sfile) {
		$return = "<style>";
		open F, $sfile;
		while (<F>) {
			chomp;
			$return .= $_;
		}
		close F;
		$return .= "</style>\n";
	}
	return $return;

#	my $v = (stat("$s->{plib}/css/$stylefile.css"))[9];
#	my $return = qq(\t<link rel="stylesheet" href="/css/$stylefile-r$v.css" />\n);
#
#	# check for a custom stylesheet
#	my $cv = (stat("/data/$s->{obase}/content/custom.css"))[9];
#	if ($cv) {
#		$return .= qq(\t<link rel="stylesheet" href="/custom-r$cv.css" />\n);
#	}
#
#	if ($s->{agent} eq 'iphone') {
#		my $scale = ($s->{allow_zoom}) ? 'yes' : 'no';
#		$return .= qq(\t<meta name="viewport" content="user-scalable=$scale, width=device-width" />\n);
#	}
#
#	return $return;
}

sub add_js {
	my $s = shift;
	my $type = shift;

	$s->{add_js}{$type} = 1;

	return '';
}

sub _head_add_js {
	my $s = shift;

	if (defined($s->{add_js})) {
		# always add prototype
		$s->{add_js}{prototype} = 1;
	}

	my $return = qq(\n<script type="text/javascript" src="/js/prototype.js"></script>\n)
		if ($s->{add_js}{prototype});

	foreach my $k (keys %{$s->{add_js}}) {
		next if ($k eq 'prototype');
		if ($k eq 'scriptaculous') {
			$return .= qq(<script type="text/javascript" src="/js/scriptaculous.js?effects,controls"></script>\n);
		} elsif ($k eq 'calendar') {
			$return .= qq(<script type="text/javascript" src="/js/calendar_date_select/calendar_date_select.js"></script>\n).
			qq(<script type="text/javascript" src="/js/calendar_date_select/format_iso_date.js"></script>\n);
		} else {
			$return .= qq(<script type="text/javascript" src="/js/$k.js"></script>\n);
		}
	}

	$return .= join "\n", @{$s->{head_js}} if (defined($s->{head_js}));

	return $return;
}

sub html_caption_scroll {
	my $s = shift;
	my $caption = shift;
	my $scroll = shift;
	my $title = shift || 'scroll';
	my $bmargin = shift || 5;

	return qq|<div class="floatleft">$caption</div><div id="clink" class="captionlink"><a href="#" onClick="javascript:dscroll(\$('$scroll'),$bmargin); \$('clink').style.display = 'none'; return true;" class="action">$title</a></div>|;
}

sub html_display_link {