type results from the CPAN

ARSObject

view release on metacpan or search on metacpan

# http://module-build.sourceforge.net/META-spec.html
#XXXXXXX This is a prototype!!!  It will change in the future!!! XXXXX#
name:         ARSObject
version:      0.57
version_from: lib/ARSObject.pm
installdirs:  site
requires:

distribution_type: module
generated_by: ExtUtils::MakeMaker version 6.30

lib/ARSObject.pm view on Meta::CPAN

sub arsmeta {		# Load/refresh ARS metadata
 my $s =shift;		# -srv, -usr, -pswd, -lang
 $s->set(@_);
 local $s->{-cmd} =($s->{-cmd} ? $s->{-cmd} .': ' : '')
	.($s->{-schgen} ? "dumper('" .$s->vfname('meta') ."')" : 'arsmeta()');
 if (ref($s->{-schgen})
 || ($s->{-schgen} && ($s->{-schgen} >1))
 || (!-e $s->vfname('-meta'))
	) {
	#
	# Data types:
	# 'integer','real','char','enum','time','decimal'
	# 'diary','attach','currency'
	# 'trim','control','table','column','page','page_holder'
	#
	my ($vfs, $vfu);
	local $s->{-schgen} =$s->{-schgen};
	if (ref($s->{-schgen}) && (-e $s->vfname('-meta'))) {
		$s->vfload('-meta');
	}
	elsif (($s->{-schgen} >1) && (-e $s->vfname('-meta'))) {

lib/ARSObject.pm view on Meta::CPAN



sub dbicols {	# DBI table columns
 my ($s, $sch, $tbl) =@_;
 # my $st =$s->dbiquery('SHOW COLUMNS FROM ' .($sch ? $sch .'.' : '') .$tbl);
 my $st =$s->dbi()->column_info('',$sch||$s->{-sqlschema}||'', $tbl||'','%');
 @{$st->fetchall_arrayref({})}
}


sub dbitypespc { # DBI column type spec
 my ($s, $d) =@_;
 ($d->{'TYPE_NAME'} ||'unknown')
 .($d->{'COLUMN_SIZE'}
	? ' (' .join(',', map {defined($d->{$_}) ? $d->{$_} : ()
		} 'COLUMN_SIZE', 'DECIMAL_DIGITS') .')'
	: '')

}

sub dbidsmetasync {	# DBI datastore - sync meta with 'arsmetasql'

lib/ARSObject.pm view on Meta::CPAN

 foreach my $tbl (sort keys %{$s->{'-meta-sql'}}) {
	my @sql;
	if ($tbl =~/^-/) {
		next
	}
	elsif (!$dbt->{$tbl}) {
		push @sql, 'CREATE TABLE ' .join('.', map {defined($_) ? $_ : ()} $s->{-sqlschema}, $tbl)
			." (\n"
			.join("\n, "
				, map {	$s->{'-meta-sql'}->{$tbl}->{-cols}->{$_}->{'TYPE_NAME'}
					? '"' .$_ .'" ' .$s->dbitypespc($s->{'-meta-sql'}->{$tbl}->{-cols}->{$_})
					.(($s->{'-meta-sql'}->{$tbl}->{-cols}->{$_}->{fieldId}||'') eq '1'
						? " PRIMARY KEY"
						: $s->{'-meta-sql'}->{$tbl}->{-cols}->{$_}->{IS_PK}
						? " UNIQUE"
						: '')
					: ()
					} sort keys %{$s->{'-meta-sql'}->{$tbl}->{-cols}})
			.')'
	}
	else {

lib/ARSObject.pm view on Meta::CPAN

			? ()
			: (lc($_->{COLUMN_NAME}) => $_)
			} $s->dbicols('',$tbl)};
		if (scalar(%$dbc)) {
		my (@altc, @addc);
		foreach my $col (sort keys %{$s->{'-meta-sql'}->{$tbl}->{-cols}}) {
			my $cl =lc($col);
			my $cm =$s->{'-meta-sql'}->{$tbl}->{-cols}->{$col};
			next if !$cm->{'TYPE_NAME'};
			if (!$dbc->{$cl}) {
				push @addc, '"' .$col .'" ' .$s->dbitypespc($cm)
			}
			elsif (($dbc->{$cl}->{'TYPE_NAME'} ne $cm->{'TYPE_NAME'})
				|| ($cm->{'TYPE_NAME'} ne 'datetime'
					? (($dbc->{$cl}->{'COLUMN_SIZE'}||0) < ($cm->{'COLUMN_SIZE'}||0))
					|| (($dbc->{$cl}->{'DECIMAL_DIGITS'}||0) ne ($cm->{'DECIMAL_DIGITS'}||0))
					: 0 )
				) {
				push @altc, '"' .$col .'" ' .$s->dbitypespc($cm)
			}
			else {
				$cm->{COLUMN_SIZE_DB} =$dbc->{$cl}->{'COLUMN_SIZE'}
					if ($cm->{COLUMN_SIZE_DB}||0) ne ($dbc->{$cl}->{'COLUMN_SIZE'}||0);
				$cm->{DECIMAL_DIGITS_DB} =$dbc->{$cl}->{'DECIMAL_DIGITS'}
					if ($cm->{DECIMAL_DIGITS_DB}||0) ne ($dbc->{$cl}->{'DECIMAL_DIGITS'}||0);
			}
		}
		foreach my $r (@addc) {
			push @sql

lib/ARSObject.pm view on Meta::CPAN

sub cgistring {	# CGI string field
 $_[0]->{-cgi}->textfield(@_[1..$#_])
}


sub cgiselect {	# CGI selection field composition
		# -onchange=>1 reloads form
 my ($s, %a) =@_;
 my $cs =$a{-onchange} && (length($a{-onchange}) ==1);
 ($cs
 ? '<input type="hidden" name="' .$a{-name} .'__C_" value="" />'
 : '')
 .$s->{-cgi}->popup_menu(%a
	, $a{-labels} && !$a{-values}
	? (-values => do{use locale; [sort {$a{-labels}->{$a} cmp $a{-labels}->{$b}} keys %{$a{-labels}}]})
	: ()
	, $cs
	? (-onchange => '{window.document.forms[0].' .$a{-name} .'__C_.value="1"; window.document.forms[0].submit(); return(false)}')
	: ()
	)
 .( $cs && ($a{-onchange}=~/^\d/) && $s->{-cgi}->param($a{-name} .'__C_')

lib/ARSObject.pm view on Meta::CPAN

				? ($_ => $a{-textfield}->{$_})
				: ()
		} qw(-name -title -class -style -size -maxlength))
		, -default=>$v
		, -override=>1
		, ($a{-strict} && !$s->{-cgi}->param("${n}__O_")
			? (-readonly=>1) # ,-hidefocus=>0, -disabled=>0
			: ())
	)
 .($s->{-cgi}->param("${n}__O_")
	? ("<input type=\"submit\" name=\"${n}__X_\" value=\"X\" title=\"close\"$ac$as />"
	  ."<input type=\"hidden\" name=\"${n}__P_\" value=\"" .(defined($v) ? $s->{-cgi}->escapeHTML($v) : '') ."\"$ac$as />\n"
	  ."<br />\n"
	  ."<select name=\"${n}__L_\" title=\"select value\" size=\"10\""
	  ."$ac$as"
	  ." ondblclick=\"{${n}__S_.focus(); ${n}__S_.click(); return(true)}\"" 
	  ." onkeypress=\"" .($s->{-cgi}->user_agent('MSIE') ? &$fs(1) : &$fs(2)) 
	  ."\">\n"
	  .join('',map {'<option'
			.((defined($v) ? $v : '') eq (defined($_) ? $_ : '') ? ' selected' : '')
			.' value="' .$s->{-cgi}->escapeHTML(defined($_) ? $_ : '') .'">' 
				.$s->{-cgi}->escapeHTML(
					!defined($_)
					? ''
					: !$a{-labels}
					? (length($_) > $aw ? substr($_,0,$aw) .'...' : $_)
					: defined($a{-labels}->{$_})
					? (length($a{-labels}->{$_}) > $aw ? substr($a{-labels}->{$_},0,$aw) .'...' : $a{-labels}->{$_})
					: '') ."</option>\n"
			} @{&$av()})
	  ."</select>\n"
	  ."<input type=\"submit\" name=\"${n}__S_\" value=\"&lt;\" title=\"set\"$ac$as />"
	  .$s->{-cgi}->button(-value=>'...', -title=>'find', -onClick=>&$fs(3))
	  ."<input type=\"submit\" name=\"${n}__X_\" value=\"X\" title=\"close\"$ac$as />"
	  ."</div>\n"
	  ."<script for=\"window\" event=\"onload\">{window.document.forms[0].${n}__L_.focus()}</script>"
		)
	: ("<input type=\"submit\" name=\"${n}__O_\" value=\"...\" title=\"open\"$ac$as />"
	 .($s->{-cgi}->param("${n}__C_") ||$s->{-cgi}->param("${n}__X_")
		? "<script for=\"window\" event=\"onload\">{window.document.forms[0].${n}__O_.focus()}</script>"
		: ''
		))
	)
}


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

lib/ARSObject.pm view on Meta::CPAN

			: (ref($a{-to}) ? join(', ',@{$a{-to}}) : $a{-to}))
			."\cM\cJ" 
			if $a{-to};
	foreach my $k (keys %a) {
		next if $k =~/^-(data|subject|html|text|from|to|sender|recipient)$/;
		next if !defined($a{$k});
		my $n =$k =~/^-(.+)/ ? ucfirst($1) .':' : $k;
		$a{-data} .=$n .' ' .$a{$k} ."\cM\cJ";
	}
	$a{-data} .="MIME-Version: 1.0\cM\cJ";
	$a{-data} .='Content-type: '  .($a{-html} ? 'text/html' : 'text/plain')
			.'; charset=' .($a{-charset}||$s->charset())
			."\cM\cJ";
	$a{-data} .='Content-Transfer-Encoding: ' .($a{-encoding} ||'8bit') ."\cM\cJ";
	$a{-data} .="\cM\cJ";
	$a{-data} .=$a{-html} ||$a{-text} ||'';
 }
 local $^W=undef;
 $s->smtp->mail($a{-sender} =~/<\s*([^<>]+)\s*>/ ? $1 : $a{-sender})
	||return(&{$s->{-die}}("SMTP sender \'" .$a{-sender} ."' -> " .($s->smtp->message()||'?')));
 $s->smtp->to(ref($a{-recipient})

lib/ARSObject.pm view on Meta::CPAN

 return(1)
	if $acf;
 foreach my $f (@{$s->{-fpl}}) {
	next	if (ref($f) ne 'HASH')
		|| (exists($f->{-used}) && !$f->{-used});
	next if exists($f->{-widget}) && !defined($f->{-widget});
	next if !$f->{-namecgi};
	my $u =cfpused($s, $f);
	next if $u && !($f->{-hidden} ||((ref($f->{-values}) eq 'ARRAY') && !scalar(@{$f->{-values}})));
	print 	defined(cfpvp($s, $f)) 
		? '<input type="hidden" name="' .$f->{-namecgi} .'__PV_" value="' 
			.$s->{-cgi}->escapeHTML(cfpvp($s, $f))
			.'" />' ."\n"
		: ''
		, !$u
		? (	defined($s->{-cgi}->param($f->{-namecgi}))
			? '<input type="hidden" name="' .$f->{-namecgi} .'" value="'
				.$s->{-cgi}->escapeHTML($s->{-cgi}->param($f->{-namecgi}))
				.'" />' ."\n"
			: '')
		: defined(cfpvv($s, $f))
		? '<input type="hidden" name="' .$f->{-namecgi} .'" value="'
			.$s->{-cgi}->escapeHTML(cfpvv($s, $f))
			.'" />' ."\n"
		: '';
 }
 print ref($cfld0) ? &{$cfld0}($s) : $cfld0;
 my $bb ='';
 foreach my $f (@{$s->{-fpl}}) {
	next	if (ref($f) ne 'HASH')
		|| (exists($f->{-used}) && !$f->{-used});
	next if !cfpused($s, $f);

lib/ARSObject.pm view on Meta::CPAN

	print &$cfld($s
	, $f->{-action} ||$f->{-preact}
		? {}
		: $f
	, (!$f->{-widget0}
		? ''
		: ref($f->{-widget0}) eq 'CODE'
		? &{$f->{-widget0}}($s, $f, cfpvv($s, $f), cfpvp($s, $f))
		: $f->{-widget0})
	. (!($f->{-action} || $f->{-preact}) && $f->{-namecgi} && defined(cfpvp($s, $f))
		? '<input type="hidden" name="' .$f->{-namecgi} .'__PV_" value="' 
			.$s->{-cgi}->escapeHTML(cfpvp($s, $f))
			.'" />'
		: ''
		)
	. (!ref($f->{-widget}) && exists($f->{-widget})
	? $f->{-widget}
	: ref($f->{-widget}) eq 'CODE'
	? &{$f->{-widget}}($s, $f, cfpvv($s, $f), cfpvp($s, $f))
	: !$f->{-namecgi}
	? ''

lib/ARSObject.pod view on Meta::CPAN


=head2 2010-06-08

Publishing 0.51 version, with several changes, enhancements and corrections.



=head2 2010-04-17

Publishing 0.50 version.
I have two prototype scripts using this module.


=head2 2010-03-30

Documentation file written


=head2 2010-03-24

Detached

( run in 0.521 second using v1.01-cache-2.11-cpan-e1769b4cff6 )