view release on metacpan or  search on metacpan

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

#$Id: $

package Apache::SdnFw::lib::Core;

use strict;
use Carp;
use Apache::SdnFw::lib::DB;
#use Apache::SdnFw::lib::Memcached;
use Apache::SdnFw::object::home;
use Template;
use LWP::UserAgent;
use Crypt::CBC;
use Crypt::Blowfish;
use XML::Dumper;
use XML::Simple;
use Net::SMTP::SSL;
use Net::FTP;
use Digest::MD5 qw(md5_hex);
use MIME::Base64 qw(encode_base64);
use MIME::QuotedPrint qw(encode_qp);
use Date::Format;
use Data::Dumper;

use Exporter;
our @ISA = qw(Exporter);
our @EXPORT = qw(mime_type);

BEGIN {
	# preload all top level objects
	# where the hell are we when we startup?
	opendir(ROOT,$ENV{HTTPD_ROOT});
	while (my $scode = readdir(ROOT)) {
		if (-d "$ENV{HTTPD_ROOT}/$scode/object") {
			print STDERR "Loading $scode...";
			my $smem = `ps -o rss --no-heading -p $$` if ($ENV{MEM_CALC});
			my $s = {};
			my %db_object;
			my $base = $scode;
			my $objectpath = "$ENV{HTTPD_ROOT}/$base/object";
			#print STDERR "Objectpath = $objectpath\n";
			my %conf;
			my $cfile = "$ENV{HTTPD_ROOT}/conf/$scode.conf";
			if (-e $cfile) {
				open F, $cfile;
				while (my $l = <F>) {
					chomp $l;
					next if ($l =~ m/^#/);
					if ($l =~ m/^([^=]+)=(.+)$/) {
						$conf{$1} = $2;
					}
				}
				close F;
				#print STDERR "DB_STRING,USER=$conf{DB_STRING},$conf{DB_USER}\n";
				$s->{dbh} = db_connect($conf{DB_STRING},$conf{DB_USER});
				%db_object = db_q($s,"
					SELECT code, name
					FROM objects
					",'keyval');
			}
			if (-d $objectpath) {
				opendir(DIR,$objectpath);
				while (my $d = readdir(DIR)) {
					next if ($d =~ m/^\./);
					next if (!-f "$objectpath/$d" || !($d =~ m/\.pm$/i));
					$d =~ s/\.pm$//i;
					#print STDERR "Trying to load $d\n";
					eval "use $base\:\:object\:\:$d";
					if ($@) {
						print STDERR "$@\nSKIPPING PRELOAD OF $objectpath/$d.pm\n";
						undef $@;
						next;
					}

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

}

sub action_html {

=head2 action_html

 my $string = $s->action_html($object,$function,$title,$params,[$class || 'action']);

=cut

	my $s = shift;
	my $object = shift;
	my $function = shift;
	my $title = shift;
	my $params = shift;
	my $class = shift || 'action';

	if ($s->check_permission($object,$function)) {
		$params = "?$params" if ($params);
		return qq(<a href="$s->{ubase}/$object/$function$params" class="$class">$title</a>);
	}

	return qq(<span class="greyout">$title</span>);
}

sub export_data {
	my $s = shift;
	my $data = shift;
	my $cols = shift;
	my $type = shift;
	my $filename = shift;

	croak "Missing filename" unless($filename);
	croak "Missing type" unless($type);
	croak "Missing columns" unless(ref $cols eq 'ARRAY');

	open F, ">/tmp/$filename";
	print F '"'.(join '","', @{$cols}).'"'."\n";
	foreach my $ref (@{$data}) {
		my @row;
		foreach my $c (@{$cols}) {
			$ref->{$c} =~ s/"/""/g;
			push @row, $ref->{$c};
		}
		print F '"'.(join '","', @row).'"'."\n";
	}
	close F;

	$s->{content_type} = 'application/csv' if ($type eq 'csv');
	$s->{content_type} = 'text/plain' if ($type ne 'csv');

	$s->{r}{file_path} = "/tmp/$filename";
	$s->{r}{filename} = $filename;
}

sub encrypt {
	my $s = shift;
	my $data = shift;

	my $k = $s->{env}{CRYPT_KEY} || 'ilikegreeneggsandhamsamiam';
	my $cipher = new Crypt::CBC($k,'Blowfish');
	my $out = $cipher->encrypt($data) if ($data);

	my @tmp;
	foreach my $c (split '', $out) {
		push @tmp, unpack('c',$c);
	}

	return join '|', @tmp;
}

sub decrypt {
	my $s = shift;
	my $data = shift;

	my $tmp;
	foreach my $c (split /\|/, $data) {
		$tmp .= pack('c',$c);
	}

	my $k = $s->{env}{CRYPT_KEY} || 'ilikegreeneggsandhamsamiam';
	my $cipher = new Crypt::CBC($k,'Blowfish');
	my $out = $cipher->decrypt($tmp) if ($tmp);

	return $out;
}

sub help {
	my $s = shift;

	# we use our function to look for help
	$s->{function} = 'home' if ($s->{function} eq 'list');

	my $path = "$s->{function}.tt";

	if ($s->{function} eq 'system') {
		unless($s->{employee}{admin}) {
			$s->alert("Sorry, you are not an admin, you can't look at that");
			return;
		}

		# show our system help file, disaster recovery type information
		$s->{nomenu} = 1;
		my $debug = "<pre>".Data::Dumper->Dump([$s])."</pre>";
		$s->tt('system.tt', { s => $s });
		#$s->{content} .= $debug;
		return;
	}

	if ($s->{in}{f} eq 'save' && $s->{employee}{admin}) {
		open F, ">/data/$s->{obase}/template/help/$s->{function}.tt";
		$s->{in}{help_text} =~ s/\r//g;
		print F $s->{in}{help_text};
		close F;
	}

	if (-e "/data/$s->{obase}/template/help/$path") {
		if ($s->{employee}{admin}) {
			$s->add_action(function => $s->{function},
				title => 'edit',
				params => "f=edit");

			if ($s->{in}{f} eq 'edit') {
				open F, "/data/$s->{obase}/template/help/$s->{function}.tt";
				while (my $line = <F>) {
					$s->{help_text} .= $s->escape($line);
				}
				close F;

				$s->tt('help_edit.tt', { s => $s, });		
				return;	
			}
		} else {
			$s->add_action(
				title => 'edit',
				class => 'greyout',
				nourl => 1);
		}

		my $help;
		$s->tt("template/help/$s->{function}.tt", { s => $s }, \$help);
		$help =~ s/\n\n/<br><br>/g;