• Your recent searches
ARSObject
2 results

 view release on metacpan or  search on metacpan

lib/ARSObject.pm  view on Meta::CPAN 

63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
,-metaid => {}               # Commonly used fields with common names and value translation
,-metadn => {}               # {fieldId | fieldName => 
                        #       {fieldName=>'name',FieldId=>id
                        #       ,strIn=>sub(self,form,{field},$_=val){}
                        #       ,strOut=>sub(self,form,{field},$_=val){}
                        #       },...}
,-maxRetrieve => 0   # ARS::ars_GetListEntry(maxRetrieve)
,-entryNo => undef   # Logical number of entry inserted
,-strFields => 1     # Translate fields data using 'strIn'/'strOut'/'-meta'?
                        # 1 - 'enumLimits', 2 - 'fieldLbvl' before 'enumLimits'
,-cmd =>''           # Command running, for err messages, script local $s->{-cmd}
,-die =>undef                # Error die/warn,  'Carp' or 'CGI::Carp...'
# ,-diemsg => undef  #
,-warn=>undef                # , see set() and connect() below
# ,-warnmsg => undef #
,-cpcon=>undef               # Translation to console codepage sub{}(self, args) -> translated
,-echo=>0            # Echo printout switch
,-dbi=>undef         # DBI object, by dbiconnect()
,-dbiconnect =>undef #
,-cgi=>undef         # CGI object, by cgi()
,-smtp=>undef

lib/ARSObject.pm  view on Meta::CPAN 

192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
                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 

848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
 $s->set(@_);
 $s->set(-die=>'Carp') if !$s->{-die};
 local $s->{-cmd} ="connect()";
 return($s) if $s->{-ctrl};
 print $s->cpcon("connect()\n") if $s->{-echo};
 return($s) if $s->{-ctrl} && ARS::ars_VerifyUser($s->{-ctrl});
 $s->{-ctrl} =ARS::ars_Login(
                $s->{-srv}, $s->{-usr}, $s->{-pswd}, $s->{-lang}
                , '' # , join('-', ($ENV{COMPUTERNAME} ||$ENV{HOSTNAME} ||eval('use Sys::Hostname;hostname') ||'localhost'), getlogin() || $> || '', $$, $^T, time())
                , 0, 0)
        || return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},undef,'ars_Login', map {$_=>$s->{$_}} qw(-srv -usr -lang))));
 $s->{-ctrl} && ARS::ars_SetSessionConfiguration($s->{-ctrl}, &ARS::AR_SESS_OVERRIDE_PREV_IP, 1);
 $s->arsmeta();
 $s
}
 
 
sub disconnect {        # Disconnect data servers
 my $s =shift;
 $s->{-ctrl} && eval{ars_Logoff($s->{-ctrl})};
 $s->{-ctrl}=undef;

lib/ARSObject.pm  view on Meta::CPAN 

895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
        $s->vfload('-meta');
        $vfs =$s->{-schgen} >2
                ? 0
                : ([stat $s->vfname('-meta')]->[9] ||0);
}
else {
        $s->{-meta} ={};
}
foreach my $f (ref($s->{-schgen}) ? @{$s->{-schgen}} : @{$s->{-schema}}){
        my $fa =ARS::ars_GetSchema($s->{-ctrl}, $f);
        !$fa && return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},undef,'ars_GetSchema',$f)));
        if ($vfs && $s->{-meta}->{$f}) {
                #print $s->strtime($fa->{timestamp}),'/',$s->strtime($vfs), "\n", $s->cpcon($s->dsdump($fa)), "\n"; exit(0);
                next    if $s->{-meta}->{$f} && $s->{-meta}->{$f}->{timestamp}
                        ? (($s->{-meta}->{$f}->{timestamp}||0) >=($fa->{timestamp}||0))
                                && ($vfs >=($fa->{timestamp}||0))
                        : $vfs >=($fa->{timestamp}||0 +60*60);
        }
        $vfu =1;
        $s->{-meta}->{$f} ={}; # {} || $fa
        $s->{-meta}->{$f}->{-fields} ={};

lib/ARSObject.pm  view on Meta::CPAN 

918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
# $s->{-meta}->{$f}->{getListFields} =$fa->{getListFields};
# $s->{-meta}->{$f}->{sortList} =$fa->{sortList};
my ($cyr, $vli, $vll) =1 && $s->{-lang} && ($s->{-lang} =~/^(?:ru)/i);
if (!$cyr && $s->{-lang}) {
        my $vlc;
        my $ull =$s->{-lang} =~/^([A-Za-z]+)/  ? $1 : $s->{-lang};
        my $ulc =$s->{-lang} =~/^([A-Za-z_]+)/ ? $1 : $s->{-lang};
        my $i =0;
        foreach my $vi (ars_GetListVUI($s->{-ctrl}, $f, 0)) {
                my $vw =ars_GetVUI($s->{-ctrl}, $f, $vi);
                # language[_territory[.codeset]][@modifier]
                # en_US.ISO8859-15@euro
                $vli =$i if !defined($vli) && !$vw->{locale};
                $vlc =$i if !defined($vlc) &&  $vw->{locale} && ($vw->{locale} =~/^\Q$ulc\E/);
                $vll =$i if !defined($vll) &&  $vw->{locale} && ($vw->{locale} =~/^\Q$ull\E/);
                last if defined($vli) && defined($vlc) && defined($vll);
                $i++
        }
        $vll =$vlc if defined($vlc);
}
my $ix ={map {$_->{unique}
                && (scalar(@{$_->{fieldIds}}) ==1)
                ? ($_->{fieldIds}->[0] => 1)
                : ()} @{$fa->{indexList}}};
my %ff =ARS::ars_GetFieldTable($s->{-ctrl}, $f);
!%ff && return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},undef,'ars_GetFieldTable',$f)));
foreach my $ff (sort keys %ff) {
        my $fm =ARS::ars_GetField($s->{-ctrl},$f,$ff{$ff})
                || return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},undef,'ars_GetField',$f,$ff)));
        # 'fieldId', 'fieldName', 'dataType'
        next    if !$fm->{dataType}
                || ($fm->{dataType} =~/^(trim|control|table|column|page)/);
        next    if !$s->{-schfdo} && $fm->{option} && ($fm->{option} == 4); # AR_FIELD_OPTION_DISPLAY
        $s->{-meta}->{$f}->{-fields}->{$ff} =$fm;
        $s->{-meta}->{$f}->{-fields}->{$ff}->{indexUnique} =$fm->{fieldId}
                if $ix->{$fm->{fieldId}}
                || ($fm->{fieldId} eq '1'); # || '179'?
        if ($fm->{displayInstanceList}->{dInstanceList}
                ) {

lib/ARSObject.pm  view on Meta::CPAN 

1332
1333
1334
1335
1336
1337
1338
1339
1340
1341
1342
1343
1344
1345
1346
1347
1348
1349
1350
1351
1352
1353
                };
        $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]}
 : $_[0]->{-meta};

lib/ARSObject.pm  view on Meta::CPAN 

1656
1657
1658
1659
1660
1661
1662
1663
1664
1665
1666
1667
1668
1669
1670
1671
1672
1673
1674
1675
1676
               if $x}
my $q =$s->_qsubst('',$a{-qual} ||$a{-query} ||$a{-where}, $f);
$s->{-cmd} .=": subst(-from=>'$f'"
               .(@$fl ? ',-fields=>' .join(', ', map {ref($_) ? "'" .$_->{fieldId} ."'(" .$_->{columnWidth} .")" : "'$_'"
                       } @$fl) : '')
               .($q ? ",-where=>$q" : '')
               .(@fs ? ',-order=>' .join(', ', map {"'$_'"} @fs) : '')
               .")"
               if 0;
$q =ARS::ars_LoadQualifier($s->{-ctrl}, $f, $q);
return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd})))
       if !$q;
$s->{-cmd} .=": qual". $s->dsquot(ARS::ars_perl_qualifier($s->{-ctrl}, $q))
       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 $_;

lib/ARSObject.pm  view on Meta::CPAN 

1681
1682
1683
1684
1685
1686
1687
1688
1689
1690
1691
1692
1693
1694
1695
1696
1697
1698
1699
1700
1701
1702
               , @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)) {

lib/ARSObject.pm  view on Meta::CPAN 

1713
1714
1715
1716
1717
1718
1719
1720
1721
1722
1723
1724
1725
1726
1727
1728
1729
1730
1731
1732
1733
1734
1735
1736
1737
1738
1739
1740
1741
1742
1743
1744
1745
1746
1747
1748
1749
1750
1751
               if (!defined(eval{&$c($s, $f, $_
                       , $a{-fetch}
                               ? $s->entry(-from=>$f, -id=>$_
                                       , ref($a{-fetch}) ? (-fields => $a{-fetch}) : ())
                               : ())}) && $@) {
                       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_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;

lib/ARSObject.pm  view on Meta::CPAN 

1761
1762
1763
1764
1765
1766
1767
1768
1769
1770
1771
1772
1773
1774
1775
1776
1777
1778
1779
1780
1781
1782
                                push @rr
                                , $s->entry(-from=>$f, -id=>$r[$i]
                                        , ref($a{-fetch}) ? (-fields=>$a{-fetch}) : ())
                        }
                }
                else {
                        for (my $i =0; $i <$#r; $i +=2) { push @rr, $r[$i] }
                }
                return(@rr)
        }
        return(&{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},undef,'ars_GetListEntry')))
                if $ARS::ars_errstr;
        return(())
 }
}
 
 
sub _qsubst {   # query condition string substitutions
                # (''|char, expr string, form) -> translated
 my ($s, $c, $q, $f) =@_;
 return($q) if !defined($q) ||($q eq '');
 my $r ='';

lib/ARSObject.pm  view on Meta::CPAN 

1889
1890
1891
1892
1893
1894
1895
1896
1897
1898
1899
1900
1901
1902
1903
1904
1905
1906
1907
1908
1909
1910
                                : $ff->{strOut}
                                ? &{$ff->{strOut}}($s,$f,$ff,$_=$r{$id})
                                : strOut($s,$f,$id,$r{$id})
                }
                else {
                        $rr->{$id} =$r{$id}
                }
        }
        return($rr)
 }
 return($ARS::ars_errstr
        ? &{$s->{-die}}($s->efmt($ARS::ars_errstr,$s->{-cmd},undef,'entry',-form=>$f,-id=>$a{-id}))
        : {})
}
 
 
sub entryOut {  # Format entry hash ref for output
                # (schema, entry, ?sample) -> entry
 my ($s, $f, $r, $rr) =@_;
 if ($rr) {
        undef(@{$rr}{keys %$rr}) if %$rr;
 }

lib/ARSObject.pm  view on Meta::CPAN 

2027
2028
2029
2030
2031
2032
2033
2034
2035
2036
2037
2038
2039
2040
2041
2042
2043
2044
2045
2046
2047
2048
2049
        my $ii=schdn($s,$f,'Incident Number')->{fieldId};
        $a{$ii} =$s->entryIns(-form=>'HPD:CFG Ticket Num Generator', 'DataTags'=>'za')
                if length($a{$ii}) <2;
        $s->{-entryNo} =$a{$ii};
        $r =ARS::ars_CreateEntry($s->{-ctrl}, $f, %a)
 }      
 else {
        $r =$s->{-entryNo} =ARS::ars_CreateEntry($s->{-ctrl}, $f, %a)
 }
 if (!$r) {
        my $t =$s->efmt($ARS::ars_errstr,$s->{-cmd});
        return(&{$s->{-die}}($t))        if !$r &&  $ARS::ars_errstr;
        # warn($t)                      if !$r && !$ARS::ars_errstr;
 }
 $r ||$s
}
 
 
sub entryUpd {  # ars_SetEntry(ctrl,schema,entry_id,getTime,...)
                # (-form=>form, -id=>entryId, field=>value) -> id
                # ?-echo=>1
 #
 # ??? ARMergeEntry()/ars_MergeEntry(ctrl, schema, mergeType, ...)

lib/ARSObject.pm  view on Meta::CPAN 

2070
2071
2072
2073
2074
2075
2076
2077
2078
2079
2080
2081
2082
2083
2084
2085
2086
2087
2088
2089
2090
2091
2092
2093
2094
2095
2096
2097
2098
2099
2100
2101
2102
2103
2104
2105
2106
2107
2108
                        my $ff =schdn($s,$f,$k);
                        $k =$ff->{fieldId};
                        $v =$ff->{strIn}
                           ? &{$ff->{strIn}}($s,$f,$ff,$_=$v)
                           : strIn($s,$f,$k,$v)
                                if $s->{-strFields}
                }
                ($k => $v)
                } keys %a;
 my $r =ARS::ars_SetEntry($s->{-ctrl}, $f, $id, 0, %a);
 return(&{$s->{-die}}($s->efmt($ARS::ars_errstr, $s->{-cmd})))
        if !$r && $ARS::ars_errstr;
 $id
}
 
 
sub entryDel {  # ars_DeleteEntry
                # (-form=>form, -id=>entryId) -> id
                # ?-echo=>1
 my ($s, %a) =@_;
 my $f =$a{-schema} ||$a{-form} ||$a{-from} ||$a{-into};
 my $id=$a{-id};
 print $s->cpcon("entryDel(-form=>'$f',-id=>'$id')\n")
        if exists($a{-echo}) ? $a{-echo} : $s->{-echo};
 delete @a{qw(-schema -form -from -into -id -echo)};
 my $r =ARS::ars_DeleteEntry($s->{-ctrl}, $f, $id);
 return(&{$s->{-die}}($s->efmt($ARS::ars_errstr
                ,"entryDel(-form=>'$f',-id=>'$id')")))
         if !$r && $ARS::ars_errstr;
 $id
}
 
 
sub entryBLOB { # BLOB field retrieve/update
                # (-form=>form, -id=>entryId, -field=>fieldId|fieldName
                # ,?-set=>data
                # ,?-file=>filePath, ?-set=>boolean
 my ($s, %a) =@_;
 my $f =$a{-schema} ||$a{-form} ||$a{-from} ||$a{-into};

lib/ARSObject.pm  view on Meta::CPAN 

2113
2114
2115
2116
2117
2118
2119
2120
2121
2122
2123
2124
2125
2126
2127
2128
2129
2130
2131
2132
2133
2134
2135
2136
2137
2138
2139
2140
2141
2142
2143
2144
2145
2146
2147
2148
2149
2150
2151
2152
2153
2154
2155
2156
2157
2158
2159
2160
2161
2162
2163
2164
2165
2166
2167
2168
2169
2170
2171
2172
2173
2174
2175
2176
2177
2178
2179
2180
2181
2182
2183
2184
2185
2186
2187
                , $a{-field}
                , {$a{-file}
                        ? ('file'=>$a{-file}, 'size'=> -s $a{-file})
                        : ('buffer'=>$a{-set}, 'size'=> length($a{-set}))
                        }))
 }
 else {
        my $r =ARS::ars_GetEntryBLOB($s->{-ctrl}, $f, $a{-id}
                ,$a{-field} =~/^\d+$/ ? $a{-field} : schdn($s,$f,$a{-field})->{fieldId}
                ,$a{-file} ? (ARS::AR_LOC_FILENAME(), $a{-file}) : (ARS::AR_LOC_BUFFER()));
        return(&{$s->{-die}}($s->efmt($ARS::ars_errstr
                ,"entryBLOB(-form=>'$f',-id=>'" .$a{-id} ."',-field=>" .$a{-field} ."')")))
                if !defined($r) && $ARS::ars_errstr;
        return(!$a{-file} ? $r : $r ? $a{-id} : $r)
 }
}
 
 
sub dbi {       # DBI connection object
 return($_[0]->{-dbi}) if $_[0]->{-dbi};
 dbiconnect(@_)
}
 
 
sub dbiconnect {# DBI connect to any database
                # (-dbiconnect=>[]) -> dbi object
 set(@_);
 set($_[0],-die=>'Carp') if !$_[0]->{-die};
 print $_[0]->cpcon("dbiconnect()\n")
        if $_[0]->{-echo};
 eval('use DBI; 1') ||return(&{$_[0]->{-die}}($_[0]->efmt('No DBI')));
 $_[0]->{-dbi} =DBI->connect(ref($_[0]->{-dbiconnect}) ? @{$_[0]->{-dbiconnect}} : $_[0]->{-dbiconnect})
        || &{$_[0]->{-die}}($_[0]->efmt(DBI->errstr,undef,undef,'dbiconnect') ."\n");
}
 
 
sub dbiquery {  # DBI query
                # (dbi query args) -> dbi cursor object
                # (-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};
 my $op =$s->{-dbi}->prepare(@q)
        || return(&{$s->{-die}}($s->efmt($s->{-dbi}->errstr, undef, undef, 'dbiprepair',@q)));
 $op->execute()
        || return(&{$s->{-die}}($s->efmt($s->{-dbi}->errstr, undef, undef, 'dbiexecute',@q)));
 $op;
}
 
 
sub dbido {     # DBI do
                # (dbi do args) -> dbi cursor object
                # (-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};
        @t =$sch

lib/ARSObject.pm  view on Meta::CPAN 

2279
2280
2281
2282
2283
2284
2285
2286
2287
2288
2289
2290
2291
2292
2293
2294
2295
2296
2297
2298
2299
                        push @sql
                                ,'ALTER TABLE '
                                .join('.', map {defined($_) ? $_ : ()} $s->{-sqlschema}, $tbl)
                                .' ALTER COLUMN ' .$r;
                }
                }
        }
        foreach my $r (@sql) {
                print "$r;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
                $s->dbi()->do($r)
                || &{$s->{-die}}($s->efmt($s->{-dbi}->errstr,$r,undef,'dbidsmetasync'));
        }
 }
 $s;
}
 
 
sub dbidsrpl {  # DBI datastore - load data from ARS
 my ($s, %arg) =@_;
 $arg{-form}  =$arg{-from}  ||$arg{-schema}     if !$arg{-form};
 $arg{-query} =$arg{-where} ||$arg{-qual}       if !$arg{-query};

lib/ARSObject.pm  view on Meta::CPAN 

2465
2466
2467
2468
2469
2470
2471
2472
2473
2474
2475
2476
2477
2478
2479
2480
2481
2482
2483
2484
2485
                               ? ('DELETE FROM ' .$tbc
                                       .' WHERE ' .$s->{-dbi}->quote_identifier($fpk->{COLUMN_NAME}) .' =' .$s->{-dbi}->quote($rd->{$fpk->{COLUMN_NAME}}))
                               : ('UPDATE ' .$tbc .' SET '
                                       .join(', ', map { !exists($rd->{$_})
                                               ? ()
                                               : ($s->{-dbi}->quote_identifier($_) .' =NULL')
                                               } '_arsobject_insert','_arsobject_update', '_arsobject_delete')
                                       .' WHERE ' .$s->{-dbi}->quote_identifier($fpk->{COLUMN_NAME}) .' =' .$s->{-dbi}->quote($rd->{$fpk->{COLUMN_NAME}}));
                       print "$sql;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
                       $s->{-dbi}->do($sql)
                       || &{$s->{-die}}($s->efmt($s->{-dbi}->errstr,$sql,undef,'dbidsrpl',$arg{-form}));
               }
               @rq =();
       }
}      
if ($arg{-ckdel}) {
       my $cnl ='';
       my $dbr =[];
       while ($dbr) {
         my $sql ='SELECT ' .$s->{-dbi}->quote_identifier($fpk->{COLUMN_NAME}) 
               .' FROM ' .$tbc

lib/ARSObject.pm  view on Meta::CPAN 

2524
2525
2526
2527
2528
2529
2530
2531
2532
2533
2534
2535
2536
2537
2538
2539
2540
2541
2542
2543
2544
2545
2546
                       @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;
       if ($arg{-master} && $arg{-master_fk} && $fts) {
               my $mtb =$s->sqlname($arg{-master});

lib/ARSObject.pm  view on Meta::CPAN 

2598
2599
2600
2601
2602
2603
2604
2605
2606
2607
2608
2609
2610
2611
2612
2613
2614
2615
2616
2617
2618
2619
                        .'>=' .$s->{-dbi}->quote($mtv)
                        .($mpv
                         ? ' AND ' .$s->{-dbi}->quote_identifier($mpk)
                                .'>=' .$s->{-dbi}->quote($mpv)
                         : '')
                : '')
                .' ORDER BY ' .$s->{-dbi}->quote_identifier($mts) .' ASC '
                .', ' .$s->{-dbi}->quote_identifier($mpk) .' ASC ';
        print "$sql;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
        $lm =$s->{-dbi}->selectcol_arrayref($sql,{'MaxRows'=>$arg{-lim_rf}});
        return(&{$s->{-die}}($s->efmt($s->{-dbi}->errstr, undef, undef, 'selectcol_arrayref',$sql)))
                if !$lm && $s->{-dbi}->errstr;
        # print $s->dsquot($lm),"\n";
        # die('TEST')
        # -form=>'HPD:HelpDesk_AuditLogSystem'
        # ,-master=>'HPD:Help Desk', -master_pk=>'Entry ID',-master_fk=>'Original Request ID', -master_ts=>'Last Modified Date'
}
my ($rw, $rd) =({});
my ($cs, $cw) =($cts,0);
while ($lm ? scalar(@$lm) : 1) {
  $cw++;
  foreach my $r ($s->query(-form=>$arg{-form}

lib/ARSObject.pm  view on Meta::CPAN 

2714
2715
2716
2717
2718
2719
2720
2721
2722
2723
2724
2725
2726
2727
2728
2729
2730
2731
2732
2733
2734
2735
2736
2737
2738
2739
2740
2741
2742
2743
2744
2745
2746
2747
2748
2749
2750
2751
2752
2753
2754
                                                        : $s->{-dbi}->quote($rw->{$_->{fieldName}})
                                                        ))
                                                } @flds)
                                .' WHERE ' .$s->{-dbi}->quote_identifier($fpk->{COLUMN_NAME}) .' =' .$s->{-dbi}->quote($rw->{$fpk->{fieldName}});
                        $cu++
                }
                if ($sql) {
                        # local $s->{-dbi}->{LongTruncOk} =1;
                        print "$sql;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
                        $s->{-dbi}->do($sql) 
                        || &{$s->{-die}}($s->efmt($s->{-dbi}->errstr,$sql,undef,'dbidsrpl',$arg{-form}));
                }
          }
          if (!$fts && ($cs == $cw *$arg{-lim_rf})) {
                sleep($arg{-sleep} ||0);
                next;
          }
          elsif ($lm) {
                sleep($arg{-sleep} ||0);
                next;
          }
          last;
        }
        if ($arg{-unused} && ($fts ? $vts : 1)) {
                my $sql ='DELETE FROM ' .$tbc .' WHERE '
                        .dbidsqq($s
                                , $vts && $fts ? '(' .$fts->{COLUMN_NAME} .'<' .$s->{-dbi}->quote($s->strtime($vts||0)) .') AND (' .$arg{-unused} .')' : $arg{-unused}
                                , $s->{'-meta-sql'}->{$tbl});
                print "$sql;\n" if exists($arg{-echo}) ? $arg{-echo} : $s->{-echo};
                my $n=  $s->{-dbi}->do($sql) 
                        || &{$s->{-die}}($s->efmt($s->{-dbi}->errstr,$sql,undef,'dbidsrpl',$arg{-form}));
                $cd +=$n;
        }
 }
 join(', ', map {$_ ? $_ : ()} $ci && "new $ci", $cu && "upd $cu", $cd && "del $cd")
        ||'up-to-date'
}
 
 
sub dbidsquery {        # DBI datastore - query data alike ARS
 my ($s, %arg) =@_;

lib/ARSObject.pm  view on Meta::CPAN 

2920
2921
2922
2923
2924
2925
2926
2927
2928
2929
2930
2931
2932
2933
2934
2935
2936
2937
2938
2939
2940
2941
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 

2994
2995
2996
2997
2998
2999
3000
3001
3002
3003
3004
3005
3006
3007
3008
3009
3010
3011
3012
3013
3014
                        .$ENV{SCRIPT_NAME}
                        if ($v !~/\w\/\w/) && $ENV{SCRIPT_NAME};
        }
        return($v)
 }
}
 
 
sub cgitext {   # CGI textarea field
 $_[0]->{-cgi}->textarea(@_[1..$#_])
        # -default=>$v, -override=>1
}
 
 
sub cgistring { # CGI string field
 $_[0]->{-cgi}->textfield(@_[1..$#_])
}
 
 
sub cgiselect { # CGI selection field composition
                # -onchange=>1 reloads form

lib/ARSObject.pm  view on Meta::CPAN 

3058
3059
3060
3061
3062
3063
3064
3065
3066
3067
3068
3069
3070
3071
3072
3073
3074
3075
3076
3077
3078
                       next if !$a{$e};
                       foreach my $k (keys %{$a{$e}}) {
                               $a{-labels}->{$k} =$a{$e}->{$k}
                       }
               }
               $a{-values}
               };
my $ac=$a{-class} ? ' class="' .$a{-class} .'"' : '';
my $as=$a{-style} ? ' style="' .$a{-style} .'"' : '';
my $aw=$a{-size} ||80;
my $v =!defined($s->{-cgi}->param($n)) ||$a{-override}
       ? $a{-default}
       : $s->{-cgi}->param($n);
   $v =&$av()->[0]
               if $a{-strict} && (!defined($v) || !grep /^\Q$v\E$/, @{&$av()});
   $s->{-cgi}->param($n, defined($v) ? $v : '');
my $ek =$s->{-cgi}->user_agent('MSIE') ? 'window.event.keyCode' : 'event.which';
my $fs =sub{
       '{var k;'
       ."var l=window.document.forms[0].$nl;"
       ."if(l.style.display=='none'){"

lib/ARSObject.pm  view on Meta::CPAN 

3113
3114
3115
3116
3117
3118
3119
3120
3121
3122
3123
3124
3125
3126
3127
3128
3129
3130
3131
3132
3133
($s->{-cgi}->param("${n}__O_")
       ? "<div><script for=\"$n\" event=\"onkeypress\">" .&$fs(0) ."</script>\n"
       : '')
.$s->{-cgi}->textfield((map {defined($_) && defined($a{$_})
                               ? ($_ => $a{$_})
                               : $a{-textfield} && $a{-textfield}->{$_} && !$s->{-cgi}->param("${n}__O_")
                               ? ($_ => $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"

lib/ARSObject.pm  view on Meta::CPAN 

3969
3970
3971
3972
3973
3974
3975
3976
3977
3978
3979
3980
3981
3982
3983
3984
3985
3986
3987
3988
3989
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 

4003
4004
4005
4006
4007
4008
4009
4010
4011
4012
4013
4014
4015
4016
4017
4018
4019
4020
4021
4022
4023
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 

4037
4038
4039
4040
4041
4042
4043
4044
4045
4046
4047
4048
4049
4050
4051
4052
4053
4054
4055
4056
4057
               $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 

4165
4166
4167
4168
4169
4170
4171
4172
4173
4174
4175
4176
4177
4178
4179
4180
4181
4182
4183
4184
4185
4186
4187
4188
4189
4190
4191
4192
4193
4194
4195
4196
4197
4198
4199
4200
4201
4202
4203
4204
4205
4206
4207
4208
4209
4210
4211
4212
               . "</th>\n<td align=\"left\" valign=\"top\">"
               . $_[2]
               . "</td></tr>"
               }
       if !$cfld;
$cfld0="\n<table>"       if !$cfld0;
$cfld1="\n</table>"      if !$cfld1;
$s->cgi();
cfpinit($s);
local $s->{-fpmsg} =$cmsg;
my $err;
my $act;
my $acf;
my $aec;
my $arv;
foreach my $f (@{$s->{-fpl}}) {
       next    if (ref($f) ne 'HASH')
               || (exists($f->{-used}) && !$f->{-used});
       if ($f->{-preact} && ($f->{-preact} !~/^\d$/) && cfpvv($s, $f)) {
               $acf =1;
               $act =[] if !$act;
               push @$act, $f
       }
       if ($f->{-action} && ($f->{-action} !~/^\d$/) && cfpvv($s, $f)) {
               $aec =cfpvv($s, $f);
       }
       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}
               ? undef

lib/ARSObject.pm  view on Meta::CPAN 

4288
4289
4290
4291
4292
4293
4294
4295
4296
4297
4298
4299
4300
4301
4302
4303
4304
4305
4306
4307
4308
4309
4310
4311
4312
4313
4314
4315
4316
4317
4318
4319
4320
4321
4322
4323
4324
4325
4326
4327
4328
4329
4330
4331
4332
4333
4334
4335
4336
4337
4338
4339
4340
4341
4342
4343
4344
4345
4346
4347
4348
4349
4350
4351
4352
4353
4354
4355
4356
4357
4358
4359
4360
4361
4362
4363
4364
4365
4366
4367
                               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 ''))
               ? $f->{-warn}
               : undef
               ) {
               print &$cmsg($s, 'Warning', "'" .$f->{-namelbl} ."' - $ev");
       }
}
return(undef)
       if $err;
$act = $acf =$arv =undef;
foreach my $f (@{$s->{-fpl}}) {
       next    if (ref($f) ne 'HASH')
               || (exists($f->{-used}) && !$f->{-used});
       next if !cfpused($s, $f);
       if ($f->{-action} && ($f->{-action} !~/^\d$/) && cfpvv($s, $f)) {
               $acf =1;
               $act =[] if !$act;
               push @$act, $f
       }
       if ($f->{-key} && $act && !$err) {
               $arv =1;
               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))
}
return(undef)
       if $err;
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))

lib/ARSObject.pm  view on Meta::CPAN 

4478
4479
4480
4481
4482
4483
4484
4485
4486
4487
4488
4489
                : ref($f->{-widget1}) eq 'CODE'
                ? &{$f->{-widget1}}($s, $f, cfpvv($s, $f), cfpvp($s, $f))
                : $f->{-widget1})
        );
 }
 if ($bb) {
        print &$cfld($s, {}, $bb);
        $bb ='';
 }
 print ref($cfld1) ? &{$cfld1}($s) : $cfld1;
 $err ? undef : 1
}

lib/ARSObject.pod  view on Meta::CPAN 

76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
 
 
=item Creation and Configuration
 
C<new>, C<set>, C<Slots>
 
 
=item Error Processing and Echo
 
C<-die>, C<-warn>, C<-echo>, C<-cpcon>/C<cpcon>;
C<ars_errstr>, C<dbierrstr>
 
 
=item Connection
 
C<connect>(C<-srv> => server, C<-usr> => name, C<-pswd> => password, C<-lang> => language);
C<-ctrl>
 
C<dbiconnect>(C<-dbiconnect>); C<-dbi>

lib/ARSObject.pod  view on Meta::CPAN 

134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
 
C<fopen>, C<fload>, C<fstore>, C<fdirls>;
 
C<soon>
 
 
 
=item Utility Objects
 
C<dbi>, C<-dbi>, C<dbiconnect>, C<-dbiconnect>;
C<dbiquery>, C<dbido>; C<dbierrstr>
 
C<cgi>, C<-cgi>, C<cgiconnect>;
C<cgipar>, C<cgiesc>, C<cgitfrm>, C<cgitext>, C<cgistring>, C<cgiselect>, C<cgiddlb>
 
C<smtp>, C<-smtp>, C<smtpconnect>, C<-smtphost>; C<smtpsend>
 
 
 
=item SQL Data Store Methods

lib/ARSObject.pod  view on Meta::CPAN 

217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
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 

297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
(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 

332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
 
 
=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 

367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
 
=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 

861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
 
 
=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 

920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
 
 
=head1 METHODS
 
=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 

1007
1008
1009
1010
1011
1012
1013
1014
1015
1016
1017
1018
1019
1020
1021
1022
1023
1024
1025
1026
1027
=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>)
Current value of the field, may be used in sub{}s executed by C<cfprun>.
 
 
=item cfpvv ('field name' || {field definition}) -> current or default field value

lib/ARSObject.pod  view on Meta::CPAN 

1041
1042
1043
1044
1045
1046
1047
1048
1049
1050
1051
1052
1053
1054
1055
1056
1057
1058
1059
1060
1061
 
 
 
=item cgiconnect (CGI args) -> CGI object
 
(C<Utility Objects>)
Connect to L<CGI|CGI>.
 
 
 
=item cgiddlb (-name=>name, ?-title=>comment, ?-values=>[values], ?-labels=>{value=>display,..}, ?-default=>value, ?-override=>bool,...) -> drop-down list box HTML
 
(C<Utility Objects>)
Generate drop-down list box HTML using L<CGI|CGI> widgets.
This is alike C<cgiselect>, but more complex.
 
 -strict=> - disable text editing, allow only to choose value from list
 
 
 
=item cgiesc (string) -> escaped string

lib/ARSObject.pod  view on Meta::CPAN 

1078
1079
1080
1081
1082
1083
1084
1085
1086
1087
1088
1089
1090
1091
1092
1093
1094
1095
1096
1097
1098
1099
1100
1101
1102
1103
1104
1105
1106
1107
1108
1109
1110
1111
1112
1113
1114
 
=item cgipar(name) -> value
 
=item cgipar(name, value)
 
(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(@_)
 
 
 
=item cgitext(-name=>name, ?-title=>comment, ?-default=>value, ?-override=>bool, ?-rows=>number, ?-columns=>number,...) -> textarea HTML field
 
(C<Utility Objects>)
Generate HTML textarea field using L<CGI|CGI>->textarea(@_)
 
 
 
=item connect (-param => value,...) -> connected
 
 
(C<Connection>)

lib/ARSObject.pod  view on Meta::CPAN 

1230
1231
1232
1233
1234
1235
1236
1237
1238
1239
1240
1241
1242
1243
1244
1245
1246
1247
1248
1249
1250
1251
-filter => undef || filter sub{}(self, {fieldName => fieldValue,...}) -> allow
 
-order => [fieldName||fieldId => 1||2,... colName||colNumber => 'asc'||'desc',...] || 'SQL ORDER BY clause'
 
-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 1.264 second using v1.01-cache-2.11-cpan-a9ef4e587e4 )