start results from the CPAN

start

ARSObject

view release on metacpan or search on metacpan

#!perl -w
#
# High level interface above ARS module
#
# Andrew V Makarow, 2010-03-02, K)
#
#
# 2010-03-24 detached
# 2010-03-02 started inside a script
# 
package ARSObject;
use vars qw($VERSION @ISA $AUTOLOAD $CGI::Carp::CUSTOM_MSG);
use UNIVERSAL;
use strict;
use POSIX qw(:fcntl_h);

$VERSION = '0.57';

my $fretry =8;

lib/ARSObject.pm view on Meta::CPAN

 #
 # -fields => [{fieldId=>1, columnWidth=>9, separator=>"\t"},...
 #		,[{fieldName=>name, width=>9},...
 #		,[{field=>name|id, width=>9},...] # 128 bytes limit strings
 # ||-fields => [fieldId | fieldName,...]	# using ars_GetListEntryWithFields()
 # ||-fields => '*' | 1 | '*-$', -xfields=>sub{} || [fieldName| fieldId,...]
 # ||-fetch => '*' | 1 | [fieldId|fieldName,...] # using ars_GetEntry() for each record
 # -order ||-sort => [fieldId, (1||2),...] # 1 - asc, 2 - desc
 #			[..., fieldName, field=>'desc', field=>'asc',...]
 # -limit ||-max => maxRetrieve
 # -first ||-start => firstRetrieve
 # -for ||-foreach => sub(self, form, id|string, ?{record}){die "last\n", die "next\n"} -> self
 # ?-echo=>1
 #
 # ars_GetListEntry(ctrl, schema, qualifier, maxRetrieve=0, firstRetrieve=0,...)
 #		..., getListFields, sortList,... 
 # ars_LoadQualifier(ctrl, schema, qualifier string)
 #
 # Using the advanced search bar:
 # 'Currency Field.VALUE'	'Currency Field' = $NULL$
 # ??? BookValue=> {conversionDate=> 1090544110, currencyCode=> 'USD', funcList=> [{currencyCode=> 'USD', value=> '0.00'}, {currencyCode=> 'EUR', value=> ''}, {currencyCode=> 'GBP', value=> ''}, {currencyCode=> 'JPY', value=> ''}, {currencyCode=> 'CA...

lib/ARSObject.pm view on Meta::CPAN

			|| (!$a{-xfields} ? 0 : ref($a{-xfields}) eq 'CODE' ? &{$a{-xfields}}($s, $ff) :  grep {($_ eq $ff->{fieldId}) || ($_ eq $ff->{fieldName})} @{$a{-xfields}})
			? ()
			: ($ff->{fieldId})
			} sort keys %{$s->{-meta}->{$f}->{-fields}}]
 }

 $a{-fetch} =1	if $a{-fields} && !ref($a{-fields});
 delete $a{-fields}	if $a{-fetch};

 local $s->{-cmd} ="query(" .join(', ',map {!defined($a{$_}) ? () : ref($a{$_}) ? "$_=>" .dsquot($s,$a{$_}) : ("$_=>" .strquot($s,$a{$_}))
		} qw(-schema -form -from -fields -fetch -qual -query -where -sort -order -limit -max -maxRetrieve -first -start))
		.")";

 my $fl = ref($a{-fetch})
	? [map {/^\d+$/ ? $_ : schdn($s,$f,$_)->{fieldId}} @{$a{-fetch}}]
	: $a{-fields} && ref($a{-fields}->[0])
	? [map {ref($_)
			? {fieldId=>$_->{fieldId} ||schdn($s,$f, $_->{fieldName} ||$_->{field})->{fieldId}
				, separator=>$_->{separator} ||"\t"
				, columnWidth=>$_->{columnWidth} ||$_->{width} ||10
				}

lib/ARSObject.pm view on Meta::CPAN

	if 0;

 print $s->cpcon(join(";\n", split /\):\s/, $s->{-cmd})), "\n"
	if exists($a{-echo}) ? $a{-echo} : $s->{-echo};

 if ($c && $a{-fields} && !ref($a{-fields}->[0])) {
	my $id;
	local $_;
	foreach my $e (ARS::ars_GetListEntryWithFields($s->{-ctrl}, $f, $q
		, $a{-limit} ||$a{-max} ||$s->{-maxRetrieve} ||0
		, $a{-first} ||$a{-start} ||0
		, $fl
		, @fs)) {
		if (!ref($e)) {
			$_ =$id =$e
		}
		elsif (!defined(eval{&$c($s, $f, $_ =$id, entryOut($s, $f, $e))}) && $@) {
			last if $@ =~/^last[\r\n]*$/;
			next if $@ =~/^next[\r\n]*$/;
			return(&{$s->{-die}}($s->efmt($@,$s->{-cmd},'eval(-for)')));
		}
	}
	return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},'undef','ars_GetListEntryWithFields')))
		if !defined($id) && $ARS::ars_errstr;
	return($s);
 }
 elsif ($c) {
	my $i =undef;
	local $_ ='';
	foreach my $e (ARS::ars_GetListEntry($s->{-ctrl}, $f, $q
		, $a{-limit} ||$a{-max} ||$s->{-maxRetrieve} ||0
		, $a{-first} ||$a{-start} ||0
		, $fl
		, @fs)) {
		if ($i)	{
			$i =0;
			$_ =$_ .($fl->[0]->{separator}) .$e
				if $a{-fields};
		}
		else {
			$i =1;
			$_ =$e;

lib/ARSObject.pm view on Meta::CPAN

			return(&{$s->{-die}}($s->efmt($@,$s->{-cmd},'eval(-for)')));
		}
	}
	return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},undef,'ars_GetListEntry')))
		if !defined($i) && $ARS::ars_errstr;
	return($s)
 }
 elsif ($a{-fields} && !ref($a{-fields}->[0])) {
	my @r =ARS::ars_GetListEntryWithFields($s->{-ctrl}, $f, $q
		, $a{-limit} ||$a{-max} ||$s->{-maxRetrieve} ||0
		, $a{-first} ||$a{-start} ||0
		, $fl
		, @fs);
	if (@r) {
		my @rr;
		for (my $i =0; $i <$#r; $i +=2) {
			push @rr, entryOut($s, $f, $r[$i+1])
		}
		return(@rr)
	}
	return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},undef,'ars_GetListEntryWithFields')))
		if $ARS::ars_errstr;
	return(())
 }
 else {
	my @r =ARS::ars_GetListEntry($s->{-ctrl}, $f, $q
		, $a{-limit} ||$a{-max} ||$s->{-maxRetrieve} ||0
		, $a{-first} ||$a{-start} ||0
		, $fl
		, @fs);
	if (@r) {
		my @rr;
		if ($a{-fields}) {
			for (my $i =0; $i <$#r; $i +=2) {
				push @rr, $r[$i]
					.($fl->[0]->{separator})
					. $r[$i+1]
			}

lib/ARSObject.pm view on Meta::CPAN

		? (-query=>join(' AND '
				, $arg{-query} ? '(' .$arg{-query} .')' : ()
				, '(' .join(' OR '
					, map {"'" .($s->{'-meta-sql'}->{$tbl}->{-cols}->{$arg{-master_fk}} && $s->{'-meta-sql'}->{$tbl}->{-cols}->{$arg{-master_fk}}->{fieldName} || $arg{-master_fk})
						."'=\"$_\""
						} splice @$lm, 0, $arg{-lim_or}) .')'))
		: (-query=>join(' AND ', map {$_ ? "($_)" : ()
				} $arg{-query}, $fts && $vts ? "'" .$fts->{fieldName} ."'>=" .$vts : ()
				) ||'1=1'
			,-limit=>$arg{-lim_rf}
			,-start=>$cs)
		,-order=>$fts
			? [$fts->{fieldName} => 'asc', $fpk->{fieldName} => 'asc']
			: [$fpk->{fieldName} => 'asc']
		)) {
		$cs++;
		next if !$r->{$fpk->{fieldName}};
		my $sql ='';
		$rd =$s->dbiquery($fpksql .$s->{-dbi}->quote($r->{$fpk->{fieldName}}))->fetchrow_hashref();
		my $ru;
		foreach my $f (@flds) {

lib/ARSObject.pm view on Meta::CPAN

sub cgiesc {	# escape strings to html
	$_[0]->{-cgi}->escapeHTML(@_[1..$#_])
}


sub cgitfrm {	# table form layot
		# -form =>{form attrs}, -table=>{table attrs}, -tr=>{tr attrs}, -td=>{}, -th=>{}
 my ($s, %a) =$_[0];
 my $i =1;
 while (ref($_[$i]) ne 'ARRAY') {$a{$_[$i]} =$_[$i+1]; $i +=2};
 $s->cgi->start_form(-method=>'POST',-action=>'', $a{-form} ? %{$a{-form}} : ())
	# ,-name=>'test'
 .$s->{-cgi}->table($a{-table} ? $a{-table} : (), "\n"
 .join(''
	, map {	my $r =$_;
		$s->{-cgi}->Tr($a{-tr} ? $a{-tr} : (), "\n"
		.join(''
			, map { ($_ =~/^</
				? $s->{-cgi}->td($a{-td} || {-align=>'left', -valign=>'top'}, $_)
				: $s->{-cgi}->th($a{-th} || $a{-td} || {-align=>'left', -valign=>'top'}, $_)
				) ."\n"

lib/ARSObject.pod view on Meta::CPAN

(C<CGI Form Presenter>)
List of C<-values> of the field, may be used in sub{}s executed by C<cfprun>.


=item cfpp ('field name' || {field definition}) -> previous field value

(C<CGI Form Presenter>)
Previous value of the field, may be used in sub{}s executed by C<cfprun>.


=item cfprun (? msg sub{}(self, 'label', 'comment'), ? form row sub{}(self, {field}, 'html'), ? 'form start html', ? 'form end html') -> success

(C<CGI Form Presenter>)
Evaluate C<-fpl> and present html form with actions.
The order of the fields is important, it is preferred to refer from
the field definition to previous fields, not to subsequent.


=item cfpv ('field name' || {field definition}) -> current field value

(C<CGI Form Presenter>)

lib/ARSObject.pod view on Meta::CPAN

=item cgiesc (string) -> escaped string

(C<Utility Objects>)
Escape string to HTML using L<CGI|CGI>->escapeHTML(@_)



=item cgitfrm (?-table=>{table attrs}, ?-tr=>{tr attrs}, ?-td=>{...}, ?-th=>{...}, [cell value,...],...) -> HTML

(C<Utility Objects>)
Generate simple HTML form in table layout using L<CGI|CGI>->start_form(),
L<CGI|CGI>->table(), L<CGI|CGI>->end_form().
'th' tag will be used for simple strings as usual labels, 'td' tag - for strings started with HTML tags.



=item cgipar() -> parameters

=item cgipar(name) -> value

=item cgipar(name, value)

(C<Utility Objects>)

lib/ARSObject.pod view on Meta::CPAN

Options: '-b' - L<binmode|perlfunc>.
See also C<fload>, C<fstore>.



=item fstore (?-opt, filename, string,...) -> success

(C<Utility Methods>)
Store strings to file.
Options: '-b' - L<binmode|perlfunc>.
Filename may be started with '>>' to add data to file.
See also C<fload>.




=item lsflds (additional field properties) -> list of field descriptions

(C<Metadata>)
List field descriptions from C<-meta>.
May be useful when scripting.

lib/ARSObject.pod view on Meta::CPAN

-where | -query => search condition string
# Syntax:
'fieldId' || 'fieldName' - fields;
"string value" - strings;
digits - numeric value, number of seconds as date value;
strIn(form, fieldName, value) - to encode value for '-where'

-order | -sort => [fieldId | fieldName => (1||2) | ('asc'|'desc'),...]
# sort order, 1 - asc, 2 - desc

-first ||-start => firstRetrieve # ARS::ars_GetListEntry() parameter

-limit ||-max => maxRetrieve # ARS::ars_GetListEntry() parameter

-for ||-foreach => sub(self, form, id|string, ?{record}){die "last\n", die "next\n"} -> self
# iterator sub{} for each row

-echo => 1
# output query and details to STDOUT

( run in 0.252 second using v1.01-cache-2.11-cpan-0d8aa00de5b )