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
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_");
}
elsif ($p =~/^(.+?)__X_$/) {
lib/ARSObject.pm view on Meta::CPAN
# -default=>$v, -override=>1
}
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_')
? '<script for="window" event="onload">window.document.forms[0].' .$a{-name} .'.focus()</script>'
: '')
}
sub cgiddlb { # CGI drop-down listbox field composition
# -strict=> - disable text edit, be alike cgiselect
my ($s, %a) =@_;
$s->cgi();
my $n =$a{-name};
lib/ARSObject.pm view on Meta::CPAN
$f->{-labels} =$s->{-strFields} && ($s->{-strFields} ==2)
? schlblsl($s, $f->{-formdb}, $f->{-namedb})
: schlbls($s, $f->{-formdb}, $f->{-namedb})
if $f->{-namedb} && $f->{-formdb}
&& !$f->{-labels}
&& schlbls($s, $f->{-formdb}, $f->{-namedb});
if ((ref($f->{-labels}) eq 'HASH')) {
foreach my $k (keys %{$f->{-labels}}) {
last if !ref($f->{-labels}->{$k});
$f->{-changelb} ={} if !$f->{-changelb};
my $n =defined($f->{-labels}->{$k}->{-label})
? $f->{-labels}->{$k}->{-label}
: defined($f->{-labels}->{$k}->{-name})
? $f->{-labels}->{$k}->{-name}
: '';
$f->{-changelb}->{$k} =$f->{-labels}->{$k};
$f->{-labels}->{$k} =$n;
}
}
if ((ref($f->{-values}) eq 'ARRAY')) {
for (my $i =0; $i <=$#{$f->{-values}}; $i++) {
last if !ref($f->{-values}->[$i]);
$f->{-changelb} ={} if !$f->{-changelb};
my $n =defined($f->{-values}->[$i]->{-name})
? $f->{-values}->[$i]->{-name}
: defined($f->{-values}->[$i]->{-label})
? $f->{-values}->[$i]->{-label}
: '';
$f->{-changelb}->{$n} =$f->{-values}->[$i];
$f->{-values}->[$i] =$n;
}
}
if ($f->{-change} ||$f->{-changelb}) {
$f->{-onchange} =1
}
if (exists($f->{-computed}) && !($f->{-readonly} ||$f->{-disabled})) {
$f->{-disabled} =1
}
if (!$f->{-namecgi} || !$f->{-action}) {
}
elsif (!$ah->{$f->{-namecgi}}) {
$ah->{$f->{-namecgi}} =$f
lib/ARSObject.pm view on Meta::CPAN
sub cfpvp { # Field Player: field previous value
# (self, field || fieldname) -> value
$_[0]->{-cgi}->param((ref($_[1])
? $_[1]->{-namecgi} ||''
: (($_[0]->{-fphc}->{$_[1]} ||$_[0]->{-fphd}->{$_[1]} ||{})->{-namecgi} ||$_[1])
) .'__PV_')
}
sub cfpvc { # Field Player: field value changed since form open?
# (self, field || fieldname) -> changed?
my ($v1, $v0) =(cfpv(@_), cfpvp(@_));
defined($v1) && defined($v0)
? $v1 ne $v0
: !defined($v1) && !defined($v0)
? 0
: 1
}
sub cfpvcc { # Field Player: field value changed in the last form submit?
# (self, field || fieldname) -> changed?
my $f =ref($_[1])
? $_[1]
: ($_[0]->{-fphc}->{$_[1]} ||$_[0]->{-fphd}->{$_[1]});
my $fn =ref($f) ? $f->{-namecgi} ||'' : '';
$f->{-onchange} ||$f->{-values}
? $_[0]->{-cgi}->param("${fn}__C_") ||!defined($_[0]->{-cgi}->param("${fn}__C_"))
: cfpvc(@_)
}
sub cfpaction { # Field Player: execute action
# (self, {action}||'action'
# , '-preact'||'-action', {key field}) -> success
my ($s, $act, $ord, $rp, $f) =@_;
my $r =1;
lib/ARSObject.pm view on Meta::CPAN
$act =undef;
}
next if !cfpused($s, $f);
my $fn =cfpn($s, $f);
if (!$f->{-reset}
? undef
: ref($f->{-reset}) eq 'CODE'
? &{$f->{-reset}}($s, $f)
: ref($f->{-reset}) eq 'ARRAY'
? grep {cfpvcc($s, $_)} @{$f->{-reset}}
# ??? read from URL interpreted as changed listbox
: $f->{-reset}
? cfpvcc($s, $f->{-reset})
: undef
) {
$s->{-cgi}->delete($fn);
}
my $fv =exists($f->{-computed})
? (ref($f->{-computed}) eq 'CODE'
? &{$f->{-computed}}($s, $f)
: ref($f->{-computed}) eq 'ARRAY'
lib/ARSObject.pm view on Meta::CPAN
$f->{-values} =&{$f->{-values}}($s, $f, $_ =$fv)
if ref($f->{-values}) eq 'CODE';
$f->{-values} =do{use locale;
[sort {lc($f->{-labels}->{$a}) cmp lc($f->{-labels}->{$b})} keys %{$f->{-labels}}]}
if $f->{-labels}
&& !$f->{-values};
if ($f->{-values}
&& (!defined($fv) || !grep /^\Q$fv\E$/, @{$f->{-values}})) {
$fv =$f->{-values}->[0];
$fv ='' if !defined($fv);
$s->{-cgi}->delete("${fn}__C_") if $f->{-change};
}
if (defined($fv)) {
$s->{-cgi}->param($fn, $fv);
$s->{-cgi}->param("${fn}__PV_", $fv)
if !defined($s->{-cgi}->param("${fn}__PV_"));
}
else {
$s->{-cgi}->delete($fn);
}
}
foreach my $q ('-change', '-changelb') {
next if !$f->{$q};
last if !cfpvcc($s, $f);
my $c =ref($f->{$q}) eq 'CODE' ? &{$f->{$q}}($s, $f, $_ =$fv) : $f->{$q};
$c =ref($c) ne 'HASH' ? undef : ref($c->{$fv}) eq 'HASH' ? $c->{$fv} : $c;
if (ref($c) eq 'HASH') {
foreach my $k (keys %$c) {
next if $k =~/^-/;
defined($c->{$k})
? $s->{-cgi}->param(cfpn($s, $k)
, ref($c->{$k}) eq 'CODE'
lib/ARSObject.pm view on Meta::CPAN
)
. (!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}
? ''
: ref($f->{-widget}) eq 'HASH'
? ( $f->{-values}
? $s->cgiselect(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}
, -onchange=>1
, map {defined($f->{$_}) ? ($_=>$f->{$_}) : ()} qw(-values -labels)
, -id => $f->{-namecgi}
, %{$f->{-widget}})
: $f->{-rows}
? $s->cgitext(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}
, -id => $f->{-namecgi}
, %{$f->{-widget}})
: $f->{-action} ||$f->{-preact}
? $s->{-cgi}->submit(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}, -value=>$f->{-namelbl}
, -id => $f->{-namecgi}
, %{$f->{-widget}})
: $s->cgistring(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}
, -id => $f->{-namecgi}
, %{$f->{-widget}})
)
: ( $f->{-values}
? $s->cgiselect(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}
, -id => $f->{-namecgi}
, -onchange=>1
, map { my $v =ref($f->{$_}) eq 'CODE' ? &{$f->{$_}}($s, $f, cfpvv($s, $f), cfpvp($s, $f)) : $f->{$_};
defined($v) ? ($_=>$v) : ()} qw(-values -labels -onchange -readonly -disabled -class -style))
: $f->{-rows}
? $s->cgitext(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}
, -id => $f->{-namecgi}
, map { my $v =ref($f->{$_}) eq 'CODE' ? &{$f->{$_}}($s, $f, cfpvv($s, $f), cfpvp($s, $f)) : $f->{$_};
defined($v) ? ($_=>$v) : ()} qw(-rows -columns -maxlength -readonly -class -style))
: $f->{-action} ||$f->{-preact}
? $s->{-cgi}->submit(-name=>$f->{-namecgi}, -title=>$f->{-namecmt}, -value=>$f->{-namelbl}
, -id => $f->{-namecgi}
, map { my $v =ref($f->{$_}) eq 'CODE' ? &{$f->{$_}}($s, $f, cfpvv($s, $f), cfpvp($s, $f)) : $f->{$_};
defined($v) ? ($_=>$v) : ()} qw(-class -style))
lib/ARSObject.pod view on Meta::CPAN
* text: C<-widget>=>'html'
* edit field: C<-name>..,
* computed: C<-name>.., C<-computed>=>sub{}
* readonly: C<-name>.., C<-readonly>=>1
* do not store: C<-name>.., C<-entryIns>=>0, C<-entryUpd>=>0, C<-vfstore>=>0
* list&refresh: C<-name>.., C<-onchange>=>1, C<-labels>, C<-values>
* optional button field: C<-name>.., C<-action>=>1, C<-used>=>condition
=item CGI Form Presenter - Field Definitions
(for each field inside C<CGI Form Presenter - Fields>)
C<-name>, C<-namecgi>, C<-namedb>, C<-metadb> => 'field name'
lib/ARSObject.pod view on Meta::CPAN
C<-master> => 'field name'
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
=back
=head1 SLOTS
lib/ARSObject.pod view on Meta::CPAN
=item -cgi
=> undef || CGI object
(C<Utility Objects>)
L<CGI|CGI> utility object.
See also C<cgi> method.
=item -change
=> not exists
|| {field name => value || sub{}({self}, {field}, $_ =value),..}
|| {value=>{field name => value,..},..}
(C<CGI Form Presenter - Field Definitions>)
Change field values when this field changed.
This may be defined also as C<-values> or C<-labels>.
=item -computed
=> not exists || value || [field name] || sub{}({self},{field}) -> value
(C<CGI Form Presenter - Field Definitions>)
Computed field value evaluator.
lib/ARSObject.pod view on Meta::CPAN
=item -labels
=> not exists || {value=>label,..} || {value=>{{-label=>label, field=>value,..},..}
|| sub{}({self},{field},$_=value) -> {value=>label,..}
(C<CGI Form Presenter - Field Definitions>)
Labels for the drop-down list box field.
If no C<-values>, this will be generated automatically.
Special {-name=>name, field=>value,..} form is to define C<-change>.
See also C<-values>.
=item -lbtran
=item -lbadd
=> not exists || true || false (default)
lib/ARSObject.pod view on Meta::CPAN
=item -values
=> not exists || [value,..] || [{-name=>name, field=>value,..},..]
|| sub{}({self},{field},$_=value) -> [value,..]
(C<CGI Form Presenter - Field Definitions>)
Values for the drop-down list box field
Special {-name=>name, field=>value,..} form is to define C<-change>.
See also C<-labels>.
=item -vfbase
=> 'script file path name-' || 'base file path name' || 'directory path/'
(C<Variable files>)
Variable files base path name, used by C<vfstore>(), C<vfload>(), C<vfname>().
lib/ARSObject.pod view on Meta::CPAN
not exists - use default widget,
undef - field not included in form,
'html' - html to display,
hidden field with previous value added if '-namecgi'
sub{} -> html to display,...
{option=>value,..} - parameters for 'cgi...' or 'CGI' field
Field definitions may be used also to generate default widget:
C<-action> => 1;
C<-labels>, C<-values>;
C<-disabled>, C<-readonly>, C<-hidden>, C<-onchange> => boolean.
=item -widget0
=item -widget1
=> not exists || 'html'
|| sub{}({self}, {field}, value, previous value) -> html
lib/ARSObject.pod view on Meta::CPAN
(C<Utility Objects>)
Get or set L<CGI|CGI> parameter - L<CGI|CGI>->param(@_)
=item cgiselect (-name=>name, ?-title=>comment, ?-values=>[values], ?-labels=>{value=>display,..}, ?-default=>value, ?-override=>bool,...) -> selection HTML field
(C<Utility Objects>)
Generate selection field HTML using L<CGI|CGI>->popup_menu(@_)
-onchange=>1 - reload form when value changed
=item cgistring (-name=>name, ?-title=>comment, ?-default=>value, ?-override=>bool, ?-size=>number, ?-maxlength=>number,...) -> text HTML field
(C<Utility Objects>)
Generate text field HTML using L<CGI|CGI>->textfield(@_)
lib/ARSObject.pod view on Meta::CPAN
=head2 2010-07-01
Publishing 0.52 version, with several enhancements and corrections.
=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
lib/ARSObject.pod view on Meta::CPAN
This is free software;
you can use redistribute it and/or modify it
under the same terms as Perl itself.
=head1 AUTHOR
Andrew V Makarow <makarow at mail.com>,
for Bank of Russia in Archangel
=cut
LICENSE
This is free software; you can use redistribute it and/or modify it
under the same terms as Perl itself.
AUTHOR
Andrew V Makarow <makarow at mail.com>, for Bank of Russia in Archangel
PREREQUISITES
Currently implemented and tested on Win32 Active Perl 5.8.
HOW TO BUILD AND INSTALL
Type:
perl Makefile.PL
( run in 0.561 second using v1.01-cache-2.11-cpan-c333fce770f )