error results from the CPAN

error

ARSObject

view release on metacpan or search on metacpan

		my $v =$^O eq 'MSWin32' ? scalar(Win32::GetFullPathName($0)) : $0;
		$s->{-vfbase} =$v =~/^(.+?[\\\/])[^\\\/]+$/ ? $1 .$a{-vfbase} : $a{-vfbase};
	}
 }
 $s
}


sub ineval {	# is inside eval{}?
		# for PerlEx and mod_perl
		# see CGI::Carp::ineval comments and errors
 return $^S	if !($ENV{GATEWAY_INTERFACE}
			&& ($ENV{GATEWAY_INTERFACE} =~/PerlEx/))
		&& !$ENV{MOD_PERL};
 my ($i, @a) =(1);
 while (@a =caller($i)) {
	return(0) if $a[0] =~/^(?:PerlEx::|Apache::Perl|Apache::Registry|Apache::ROOT)/i;
	return(1) if $a[3] eq '(eval)';
	$i +=1;
 }
 $^S
}

		# error message form ??? use ???
		# (err/var, command, operation, function, args)
sub efmt {
	efmt1(@_)
}

sub efmt0 {
 my ($s, $e, $c, $o, $f, @a) =@_;
 cpcon($s
	,join(': '
		,($c ? $c : ())
		,($f ? $f .'(' .join(',', map {$s->dsquot($_)} @a) .')' : ())
		,($o ? $o : ())
		)
	.($e && ($e eq '$!') && $^E ? (' -> ' .$! .' / ' .$^E) : ( ' -> ' .($e || 'unknown error')))
	)
}

sub efmt1 {
 my ($s, $e, $c, $o, $f, @a) =@_;
 cpcon($s
	,join(' # '
		,($e && ($e eq '$!') && $^E ? ($! .' / ' .$^E) : ($e || 'unknown error'))
		,($o ? $o : ())
		,($f ? $f .'(' .join(',', map {$s->dsquot($_)} @a) .')' : ())
		,($c ? $c : ())
		)
	)
}


sub strquot {	# Quote and Escape string enclosing in ''
 my $v =$_[1];		# (string) -> escaped

lib/ARSObject.pm view on Meta::CPAN

		};
	$s->{'-meta-sql'}->{$tn}->{-cols}->{$tc} =$tch;
	$s->{'-meta-sql'}->{$tn}->{-fields}->{$ff} =$tc;
	$s->{'-meta-sql'}->{$tn}->{-ids}->{$ffh->{fieldId}} =$tc
		if $ffh->{fieldId};
 }
 $tc
}


sub ars_errstr {# Last ARS error
	$ARS::ars_errstr
}



sub schema {	# Schema by form name
		# (schema) -> {schema descr}
		# () -> {schemaName=>{descr}}
 $_[1]
 ? $_[0]->{-meta}->{ref($_[1]) ? $_[1]->{schemaName} : $_[1]}

lib/ARSObject.pm view on Meta::CPAN

		# (-echo=>1,...)
 my($s, @q) =@_;
 my(%a); while ($#q && ($q[0] =~/^-/)) {$a{$q[0]} =$q[1]; shift @q; shift @q};
 print $s->cpcon("dbiquery($q[0])\n")
	if exists($a{-echo}) ? $a{-echo} : $s->{-echo};
 $s->{-dbi}->do(@q)
	|| &{$s->{-die}}($s->efmt($s->{-dbi}->errstr, undef, undef, 'dbido',@q));
}


sub dbierrstr {	# Last DBI error
 $_[0]->{-dbi}->errstr
}


sub dbitables {	# DBI tables array
 my ($s, $sch, $tbl) =@_;
 my @t =$s->dbi()->tables('',$sch||$s->{-sqlschema}||'', $tbl||'%');
 if (!scalar(@t) 
 && (((ref($s->{-dbiconnect}) ? $s->{-dbiconnect}->[0] : $s->{-dbiconnect})||'') =~/^dbi:ADO:/i)) {
	$sch =$sch||$s->{-sqlschema};

lib/ARSObject.pm view on Meta::CPAN

			@cnd =();
			sleep($arg{-sleep} ||0);
			if (scalar(@del)) {
				$dbq->finish();
				last;
			}
		}
	  }
	  foreach $sql (@rms) {
				print "$sql;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
				$@ ='Unknown error';
				$s->{-dbi}->do($sql)
				|| &{$s->{-die}}($s->efmt($s->{-dbi}->errstr,$sql,undef,'dbidsrpl',$arg{-form}));
	  }
	}
 }
 if (!exists($arg{-ckupd}) || $arg{-ckupd}) {
	my $sqlm=0;
	local $s->{-strFields} =0;
	my $fpksql ='SELECT * FROM ' .$tbc .' WHERE ' .$fpk->{COLUMN_NAME} .'=';
	my $lm;

lib/ARSObject.pm view on Meta::CPAN

 local $^W =0; 
 $ENV{HTTP_USER_AGENT} =$ENV{HTTP_USER_AGENT}||'';
 $ENV{PERLXS} ='PerlIS' if !$ENV{PERLXS} && ($^O eq 'MSWin32') && $0 =~/[\\\/]perlis\.dll$/i;
 eval('use CGI; 1')
	||return(&{$s->{-die}}($s->efmt('No CGI')));
 $s->{-cgi} =$CGI::Q =$CGI::Q =eval{CGI->new(@_)}
	||return($s->{-die}
		? &{$s->{-die}}($s->efmt($@, undef, undef, 'cgi'))
		: CORE::die($s->efmt($@, undef, undef, 'cgi')));
 $s->set(-die=>'CGI::Carp fatalsToBrowser') if !$s->{-die};
 return(&{$s->{-die}}($s->efmt($s->{-cgi}->{'.cgi_error'}, undef, undef, 'cgi')))
	if $s->{-cgi}->{'.cgi_error'};
 if (1) {	# parse parameters
		# __C_ change(d), 
		# __O_ open, __L_ listbox choise, __S_ set, __X_ close
		# __P_ previous value
		# __B_ button for javascript
	foreach my $p ($s->{-cgi}->param) {
		if ($p =~/^(.+?)__S_$/) {
			$s->{-cgi}->param($1, $s->{-cgi}->param("$1__L_"));
			$s->{-cgi}->param("$1__C_", 1);
			$s->{-cgi}->delete("$1__L_");

lib/ARSObject.pm view on Meta::CPAN

	my $fs =$f->{-vfname} ||$af->{-vfname};
	$r =eval{$s->connect()
		&& $s->entryIns(-form=>$frm
			, map {	&$ffc($s, $_) ||(exists($_->{-entryIns}) && !$_->{-entryIns})
			? ()
			: ($_->{-namedb} => &$fvu($s, $_))
			} cfpused($s))}
		if $frm;
	$r =1 if ref($r);
	if (!$r) {
		$@ ="Unknown 'entryIns' error" if !$@
	}
	elsif (!$fs ||!$f->{-key}) {
	}
	elsif (($af->{-vfclear} || $f->{-vfclear}) && $s->{"${fs}-calc"}) {
		$s->vfclear($fs);
	}
	elsif (($af->{-vfrenew} || $f->{-vfrenew}) && $s->{"${fs}-store"}) {
		eval{$s->vfclear($fs); $s->vfrenew($fs)}
	}
	elsif ($af->{-vfedit} || $f->{-vfedit}) {

lib/ARSObject.pm view on Meta::CPAN

 elsif ($ae eq 'entryUpd') {	# -action
	my $fs =$f->{-vfname} ||$af->{-vfname};
	$r =eval{$s->connect()
		&& $s->entryUpd(-form=>$frm, -id=>cfpvv($s,$f)
		, map { &$ffc($s, $_) ||(exists($_->{-entryUpd}) && !$_->{-entryUpd})
			? ()
			: ($_->{-namedb} => &$fvu($s, $_))
			} cfpused($s))}
		if $frm && cfpvv($s,$f);
	if (!$r) {
		$@ ="Unknown 'entryUpd' error" if !$@
	}
	elsif (!$f->{-key} ||!$fs) {
	}
	elsif (($af->{-vfclear} || $f->{-vfclear}) && $s->{"${fs}-calc"}) {
		$s->vfclear($fs);
	}
	elsif (($af->{-vfrenew} || $f->{-vfrenew}) && $s->{"${fs}-store"}) {
		eval{$s->vfclear($fs); $s->vfrenew($fs)}
	}
	elsif ($af->{-vfedit} || $f->{-vfedit}) {

lib/ARSObject.pm view on Meta::CPAN

		$s->vfclear($fs);
	}
 }
 elsif ($act eq 'entryDel') {	# -action
	my $fs =$f->{-vfname} ||$af->{-vfname};
	$r =eval{$s->connect()
		&& $s->entryDel(-form=>$frm
		, -id=>cfpvv($s,$f))}
		if $frm && cfpvv($s,$f);
	if (!$r) {
		$@ ="Unknown 'entryDel' error" if !$@
	}
	elsif (!$fs ||!$f->{-key}) {
	}
	elsif (($af->{-vfclear} || $f->{-vfclear}) && $s->{"${fs}-calc"}) {
		$s->vfclear($fs);
	}
	elsif (($af->{-vfrenew} || $f->{-vfrenew}) && $s->{"${fs}-store"}) {
		eval{$s->vfclear($fs); $s->vfrenew($fs)}
	}
	elsif ($af->{-vfedit} || $f->{-vfedit}) {

lib/ARSObject.pm view on Meta::CPAN

	if ($f->{-key} && $act && !$err) {
		$arv =1;
		foreach my $a (@$act) {
			$arv =cfpaction($s, $a, '-preact', $arv, $f);
			next if $arv;
			$err =$@;
			last
		}
		$act =undef;
		if (!$arv) {
			&$emsg($s, $err ||"Unknown 'cfpaction' error");
			$err =1;
			last;
		}
	}
	if ($f->{-key}) {
		$act =undef;
	}
	next if !cfpused($s, $f);
	my $fn =cfpn($s, $f);
	if (!$f->{-reset}

lib/ARSObject.pm view on Meta::CPAN

				defined($c->{$k})
				? $s->{-cgi}->param(cfpn($s, $k)
					, ref($c->{$k}) eq 'CODE'
					? &{$c->{$k}}($s, $f, $_ =$fv)
					: $c->{$k}
					)
				: $s->{-cgi}->delete(cfpn($s, $k))
			}
		}
	}
	if (my $ev =!$aec || !$f->{-error}
		? undef
		: ref($f->{-error}) eq 'CODE'
		? &{$f->{-error}}($s, $f, $_ =$fv, cfpvp($s, $f), $aec)
		: !ref($f->{-error}) && (!defined($fv) || ($fv eq ''))
		? $f->{-error}
		: undef
		) {
		print &$cmsg($s, 'Error', "'" .$f->{-namelbl} ."' - $ev");
		$err =1;
	}
	if (my $ev =!$f->{-warn}
		? undef
		: ref($f->{-warn}) eq 'CODE'
		? &{$f->{-warn}}($s, $f, $_ =$fv, cfpvp($s, $f), $aec)
		: !ref($f->{-warn}) && (!defined($fv) || ($fv eq ''))

lib/ARSObject.pm view on Meta::CPAN

		foreach my $a (@$act) {
			print &$cmsg($s, 'Executing', ($a->{-namelbl} ||$a->{-namecgi} ||'') .' ', $arv)
				if $a->{-namelbl} ||$a->{-namecgi};
			$arv =cfpaction($s, $a, '-action', $arv, $f);
			next if $arv;
			$err =$@;
			last;
		}
		$act =undef;
		if (!$arv) {
			&$emsg($s, $err ||"Unknown 'cfpaction' error");
			$err =1;
			last;
		}
	}
	if ($f->{-key}) {
		$act =undef;
	}
 }
 if ($acf) {
	print &$cmsg($s, 'Done', $err ? ('Error', $@) : ('Success', $arv))

lib/ARSObject.pod view on Meta::CPAN

C<-computed>, C<-value> => value || ['field from'] || sub{} -> value

C<-undef> => value

C<-values> => [value,..] || sub{}, C<-labels> => {value => label,..} || sub{}; C<-lbtran>, C<-lbadd> => boolean

C<-reset> => 'field name' || ['field',...] || condition sub{}

C<-change> => {set field values}

C<-error>, C<-warn> => sub{} -> 'text'

C<-widget> => {definitions for cgi field in the C<Utility Objects>} || html || sub{}->html
Field definitions may be used also:
C<-action> => 1;
C<-labels>, C<-values>;
C<-disabled>, C<-readonly>, C<-hidden>, C<-onchange> => boolean.

C<-widget0> => html above C<-widget> || sub{} -> html

C<-widget1> => html below C<-widget> || sub{} -> html

lib/ARSObject.pod view on Meta::CPAN

(C<CGI Form Presenter - Field Definitions>)
Computed field value evaluator.
See also C<-value>.


=item -cpcon

	=> undef || sub{}(self, arg,...) -> translated

(C<Error Processing and Echo>)
Translation sub{} for error messages and C<-echo> printout.
I.e. sub{$_[0]->C<cptran>('ansi'=>'oem',@_[1..$#_])}


=item -ctrl

	=> undef || ARS control struct

(C<Connection>)
ARS control struct from ARS::ars_Login()

lib/ARSObject.pod view on Meta::CPAN



=item -die

	=> undef || sub{}

	=> set(-die => 'Carp' || 'CGI::Carp' || 'CGI::Carp qw(fatalsToBrowser warningsToBrowser)' || 'CGI::Die')

(C<Error Processing and Echo>)
Error die sub{}.
The most C<Methods> dies when error.
Call C<set>(C<-die> => 'Carp') to use L<Carp|Carp> module.
Call C<set>(C<-die> => 'CGI::Carp fatalsToBrowser') to use L<CGI::Carp|CGI/Carp> module.

See also C<-diemsg>, C<-warn>, C<-cpcon>


=item -diemsg

	=> undef || sub{}(string)

lib/ARSObject.pod view on Meta::CPAN


=item -entryNo

	=> entryIns()

(C<ARS methods>)
The logical number of the entry inserted by C<entryIns>().



=item -error

	=> not exists
	|| sub{}({self}, {field}, $_ =field value, previous value) -> 'error text'
	|| 'error text for empty field'

(C<CGI Form Presenter - Field Definitions>)
Field value error evaluator
See also C<-warn>.



=item -fpl

	=> [-formdb=>'...',-record=>'...'
	, {action field},.. {view/edit field},.., {button field},..}]

=item -fphc

lib/ARSObject.pod view on Meta::CPAN



=item -warn

	=> not exists
	|| sub{}({self}, {field}, $_ =field value, previous value) -> 'warning text'
	|| 'warning text for empty field'

(C<CGI Form Presenter - Field Definitions>)
Field value warning evaluator.
See also C<-error>.



=item -warnmsg

	=> undef || sub{}(string)

Message for C<-warn>, alike C<-diemsg>.

lib/ARSObject.pod view on Meta::CPAN


=over

=item Methods



=item ars_errstr () -> $ARS::ars_errstr

(C<Error Processing and Echo>)
Last ARS error.


=item arsmeta (-param => value,...)

(C<Metadata>)
Load/refresh ARS metadata (C<vfload>/C<vfstore>(C<-meta>), C<-metadn>, C<-metaid>).
Called from C<connect>.
May be called without C<connect> if metadata file exists.
See also C<arsmetamin>.

lib/ARSObject.pod view on Meta::CPAN


-undefs => undef || 1 || 0 - include undefined values to records returned

"ARS form name", "ARS field name", "ARS form name"."ARS field name" may be used
in '-fields' and '-query'.


=item dbierrstr () -> dbi->errstr

(C<Error Processing and Echo>)
Last L<DBI|DBI> error, <dbi>->errstr



=item dbiquery (dbi query args, ?-echo=>1) -> dbi cursor object

(C<Utility Objects>)
Query L<DBI|DBI> database using C<dbi>, 'prepare', 'execute'.
Use -echo=>1 to output command to STDOUT.

( run in 0.587 second using v1.01-cache-2.11-cpan-65fba6d93b7 )