view release on metacpan or  search on metacpan

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

	if ($s->{o}{perl_dump}) {
		$s->{perl_dump}{error} = $message;
	} elsif (!defined($s->{tt})) {
		print "alert: $message\n";
		$s->{message} .= $message;
	} else {
		if ($s->{quiet_errors} && $croak) {
			$message = "Sorry an error has occured";
		}
		$s->tt('alert.tt', { s => $s, message => $message, class => $class }, \$alert);
		$s->{message} .= $alert;
	}


	# add some debugging information so we know where the error is getting called from
	#$s->{message} .= "<pre>".Carp::longmess('Stack-Trace')."</pre>";

	if ($croak && $s->{object} ne 'e') {
		$s->send_error($croak);
	}
}

sub send_error {

=head2 send_error

 $s->send_error($msg);

=cut

	my $s = shift;
	my $msg = shift;

	# make sure we do not report errors to ourself, otherwise we go into a circular loop!
	# if this was a croak, it means that we should record this error into the main error
	# recording system
	my $error = $s->escape($msg);
	my $employee = '<employee>'.$s->escape("$s->{employee_id} $s->{employee}{name}").
		'</employee>' if ($s->{employee_id});
	my $in = $s->escape(Data::Dumper->Dump([\%{$s->{in}}]));
	my $env = $s->escape(Data::Dumper->Dump([\%{$s->{env}}]));
	my $session = $s->escape(Data::Dumper->Dump([\%{$s->{session_data}}]));
	my $uri = $s->escape($s->{uri});

	my $xml = <<END;
<?xml version="1.0" encoding="UTF-8"?>
<error>
	<message>$error</message>
	$employee
	<var_in>$in</var_in>
	<uri>$uri</uri>
	<var_env>$env</var_env>
	<remote_addr>$s->{remote_addr}</remote_addr>
	<server_name>$s->{server_name}</server_name>
	<session_data>$session</session_data>
</error>
END

	my $ua = new LWP::UserAgent;
	$ua->timeout(5);
	my $req = new HTTP::Request('POST' => "http://erp.smalldognet.com/sdnerp/e");
	$req->content_type('application/x-www-form-urlencoded');
	$req->content($xml);

	$ua->request($req);
}	

sub lwp_xml {
	my $s = shift;
	my $url = shift;

	my $ua = new LWP::UserAgent;
	my $req = new HTTP::Request('GET' => $url);
	my $resp = $ua->request($req);

	if ($resp->is_success) {
		my $content = $resp->content;
		my $xml = eval { XMLin($content); };
		if ($@) {
			croak "Failed to eval returned xml: $@";
		} else {
			return $xml;
		}
	} else {
		croak "Request to $url failed";
	}
}

sub confirm {

=head2 confirm

 $s->confirm($msg);

=cut

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

	$s->tt('confirm.tt', { s => $s, message => $message });
}

sub notify {

=head2 notify

 $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) {

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

			#print "was going to put $filename to $hash->{ftp_server}\n";
			$ftp->put("/tmp/$filename") || die "Failed to put $filename: ", $ftp->message;
			return 1;
		}
	}

	die "Did not find inbox/incoming on $hash->{ftp_server}";
}

sub _ftp_file {
	my $hash = shift;
	my $filename = shift;

	my $ftp = Net::FTP->new($hash->{ftp_server}) || die "Can not connect to $hash->{ftp_server}: $@";
	$ftp->login($hash->{ftp_username},$hash->{ftp_password}) || die "Login failed to $hash->{ftp_server}: $@";

	if ($hash->{ftp_path}) {
		#print "CWD $hash->{ftp_path}\n";
		$ftp->cwd($hash->{ftp_path}) || die "Error cwd to $hash->{ftp_path}: ",$ftp->message;
	}

	my @dirs = $ftp->ls();

	foreach my $f (@dirs) {
		$f =~ s/^\.\///;
		#print "Checking $f\n";
		if ($f =~ m/^(inbox|incoming)$/i) {
			$ftp->cwd($f) || die "Error cwd to $f: ", $ftp->message;
			#print "was going to put $filename to $hash->{ftp_server}\n";
			$ftp->put("/tmp/$filename") || die "Failed to put $filename: ", $ftp->message;
			return 1;
		}
	}

	die "Did not find inbox/incoming on $hash->{ftp_server}";
}

sub edi_post {

=head2 edi_post

 my $data = $s->edi_post($ref,$url,$data);

=cut

	my $s = shift;
	my $ref = shift;
	my $url = shift;
	my $data = shift;

	my $server = ($s->{env}{DEV})
		? $ref->{sdn_dev_url}
		: $ref->{sdn_url};
	
	croak "Unknown sdn_url" unless($server);

	my $ua = new LWP::UserAgent;
	$ua->timeout(5);
	my $dump = new XML::Dumper;
	my $xml = $dump->pl2xml($data);
	my $req = new HTTP::Request('POST' => "$server$url");
	$req->content_type('application/x-www-form-urlencoded');
	$req->content('<?xml version="1.0" encoding="UTF-8"?>'.$xml);
	my $resp = $ua->request($req);
	my $rxml;
	if ($resp->is_success) {
		my $rxml = $dump->xml2pl($resp->content);
		if (defined($rxml->{data})) {
			return $rxml->{data};
		} elsif (defined($rxml->{error})) {
			$s->alert("Error from $server: $rxml->{error}");
			return undef;
		}
	} else {
		$s->alert("Connection error to $server$url: ".$resp->status_line);
		return undef;
	}
}

sub edi_get {

=head2 edi_get

 my $data = $s->edi_post($ref,$url);

=cut

	my $s = shift;
	my $ref = shift;
	my $url = shift;

	my $server = ($s->{env}{DEV})
		? $ref->{sdn_dev_url}
		: $ref->{sdn_url};
	
	croak "Unknown sdn_url" unless($server);

	my $ua = new LWP::UserAgent;
	$ua->timeout(5);
	my $req = new HTTP::Request('GET' => "$server$url");
	my $resp = $ua->request($req);
	my $rxml;
	if ($resp->is_success) {
		my $dump = new XML::Dumper;
		my $rxml = $dump->xml2pl($resp->content);
		if (defined($rxml->{data})) {
			return $rxml->{data};
		} elsif (defined($rxml->{error})) {
			$s->alert("Error from $server: $rxml->{error}");
			return undef;
		}
	} else {
		$s->alert("Connection error to $server$url: ".$resp->status_line);
		return undef;
	}
}

sub access {
	my $s = shift;
	my $function = shift;

	# check and see if we have an entry for this object/function
	my %hash = $s->db_q("
		SELECT a.action_id, a.name, a.a_object, a.a_function,
			concat(ga.group_id) as groups
		FROM actions_v a
			LEFT JOIN group_actions ga ON a.action_id=ga.action_id
		WHERE a.a_object=?
		AND a.a_function=?
		GROUP BY 1,2,3,4
		",'hash',
		v => [ $s->{object}, $function ]);

	#croak "<pre>".Data::Dumper->Dump([\%hash])."</pre>";

	# if we do not, then add the object/function to the admin group
	unless($hash{action_id}) {
		$hash{groups} = $s->_set_default_access($s->{object},$function);
	}

	# we have a problem here....how do we deal with people who
	# we do not want to to have access to "everything"?
	# if someone has "strict_perms", then skip this everyone check

	# if there are no groups listed, then it's open to everyone
	if (!$hash{groups} && !$s->{employee}{strict_perms}) {
		# set a flag so we know we can skip location checking as well
		$s->{no_location_check} = 1;
		return 1;
	}

	# otherwise check and see which group this person belongs to
	foreach my $g (split ',', $hash{groups}) {
		foreach my $eg (split ',', $s->{employee}{groups}) {
			return 1 if ($g eq $eg);
		}
	}

	my $alert;
	$s->tt('noaccess.tt', { s => $s,