view release on metacpan or  search on metacpan

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

	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]);

	my $base = $s->{obase} || $s->{env}{OBJECT_BASE};
	my $package = $base.'::edimap::'.$vendor->{code}.'::'.$doctype;

	no strict 'refs';

	eval "use $package";

	my $function = $package.'::build';

	my %return = &{$function}($s,$vendor,$data);

	return %return;
}

sub format_x12 {

=head2 format_x12

 my $x12 = $s->format_x12($vendor_edi_document_id,\%data);

=cut

	my $s = shift;
	my $vendor_edi_document_id = shift;
	my $data = shift;

	my @list = $s->db_q("
		SELECT segment_code, segment_order, element_code,
			element_order, name, element_type, min_length,
			max_length, segment_option
		FROM vendor_edi_segment_elements_v
		WHERE vendor_edi_document_id=?
		ORDER BY segment_order, element_order
		",'arrayhash',
		v => [ $vendor_edi_document_id ]);

	unless(defined($data->{vendor})) {
		croak "Missing vendor information in data";
	}

	my %work;
	foreach my $ref (@list) {