view release on metacpan or  search on metacpan

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

		# run our pre logic
		my $pre = $s->{obase}.'::object::config::pre';
		if (defined(&{$pre})) {
			return unless(&{$pre}($s));
		}

		my $addhelp;
		if ($s->{employee}{admin}) {
			$addhelp = 1; # add a help link for admin
		} else {
			if (-e "/data/$s->{obase}/template/help/$s->{object}.tt") {
				$addhelp = 1;
			}
		}

		$s->add_action(object => 'help',
			title => 'help',
			function => $s->{object}) if ($addhelp && !$s->{agent});

		return unless($s->call($s->{function}));
	}

	if ($s->{object} ne 'help') {
		# do any post processing
		my $post = $s->{obase}.'::object::config::post';
		if (defined(&{$post})) {
			&{$post}($s);
		}
	}

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

sub call {
	my $s = shift;
	my $f = shift;

	# make sure it's a valid function
	unless(defined($s->{o}{functions}{$f})) {
		$s->alert("Sorry, $f is not defined for $s->{object}");
		return 0;
	}

	my $function = $s->{obj_base}.'::'.$f;

	no strict 'refs';
	# do a final check to see if the function is valid
	# and maybe call the generic function
	unless (defined(&{$function})) {
		$function = 'generic_'.$f;
		unless(defined(&{$function})) {
			$s->alert("Sorry, you can not $f a $s->{object}");
			return 0;
		}
	}

	# setup some convience variables so we have to type less
	$s->{uof} = "$s->{ubase}/$s->{object}/$s->{function}";
	$s->{uo} = "$s->{ubase}/$s->{object}";

	if ($s->{o}{log_stderr}) {
		my $dd = Data::Dumper->new([\%{$s->{in}}],[qw(data)]);
		$dd->Indent(0);
		$s->db_insert('object_debug',{
			o => $s->{object},
			f => $s->{function},
			i => $dd->Dump(),
			});
	}

	# actually call the function
	eval {
		&{$function}($s);
		};

	if ($@) {
		# force text/html just in case so we always return html....
		$s->{content_type} = 'text/html';
		if ($s->{dbh}->{AutoCommit} == 0) {
			$s->{dbh}->rollback;
		}
		# check for database errors and report them differently.....
		if ($@ =~ m/^ERROR:\s+alert:(.+)/) {
			$s->alert($1);
		} elsif ($@ =~ m/^alert:(.+)/) {
			my $msg = $1;
			$msg =~ s/ at \/usr.+$//g;
			$s->alert($msg);
		} elsif ($s->{api}) {
			$s->alert($@,$@);
		} else {
			$s->alert("<pre>$@</pre>",$@);
		}
	}
}

sub build_x12 {

=head2 build_x12

 my %hash = $s->build_x12($doctype,\%vendor,\%data);

This function looks for a perl parser file for the specific vendor
for the specific $doctype (850, 855, 856, 810, etc) and returns 
a hash which can then be fed into format_x12.

=cut

	my $s = shift;
	my $doctype = shift;
	my $vendor = shift;
	my $data = shift;

#	my $function = $s->{obj_base}.'::'.$f;

	croak "Unknown vendor code" unless($vendor->{code});
	croak "Missing doctype" unless($doctype);

	#croak "vendor=".Data::Dumper->Dump([$vendor]);
	#croak "data=".Data::Dumper->Dump([$data]);