DBIx-Web
view release on metacpan or search on metacpan
lib/DBIx/Web.pm view on Meta::CPAN
}
$a->{-rows} =($m->{-arows} >$ar ? $m->{-arows} : $ar);
$a->{-rows} =20 if $a->{-rows} >30;
}
if (defined($m->{-hrefs})) {
my $h =$s->ishtml($v)
? $s->trURLhtm($v, undef, \&trURLhref)
: $s->trURLtxt($v, undef, \&trURLhref);
$wgp .=join('; ', @$h);
$wgp .='<br />' if $wgp;
}
$wgp .=$s->cgi->textarea(
($cs ? (-class=>$cs) : ())
,(map {($_ => (ref($a->{$_}) eq 'CODE'
? &{$a->{$_}}($s,$a,local($_)=$v)
: $a->{$_}))} keys %$a)
,-name=>$n, -title=>$t, -default=>$v, -override=>1);
$wgp .="<input type=\"submit\" name=\"${n}__b\" value=\"R\" "
."title=\"Rich/Text edit: ^Bold, ^Italic, ^Underline, ^hyperlinK, Enter/shift-Enter, ^(shift)T ident, ^Z undo, ^Y redo.\" "
.($cs ? 'class="' .htmlEscape($s,$cs) .'" ': '')
."style=\"font-style: italic;\" "
."onclick=\"{if(${n}__b.value=='R') {${n}__b.value='T'; $n.style.display='none'; "
."\n var r; r =document.createElement('<span contenteditable=true id="${n}__r" title="MSHTML Editing Component" ondeactivate="{$n.value=${n}__r.innerHTML}"></span>'); ${n}__b.parentNode.insertBefore(r, $n)\n"
."r.contentEditable='true'; r.style.borderStyle='inset'; r.style.borderWidth='thin'; r.normalize; r.innerHTML =!$n.value ? ' ' : $n.value; r.focus();}\n"
."else {${n}__b.value='R'; $n.value=!${n}__r.innerHTML ? '' : ${n}__r.innerHTML.substr(0,1)!='<' && ${n}__r.innerHTML.indexOf('<')>=0 ? '<span></span>' +${n}__r.innerHTML : ${n}__r.innerHTML; ${n}__r.removeNode(true); $n.style.dis...
#${n}__r.innerHTML ? ${n}__r.innerHTML : ''; ${n}__r.removeNode(true); $n.style.display='inline'; $n.focus();};\n"
." return(false)}\" />\n"
#MSHTML Edit Control for IE5.5
if $m->{-htmlopt} && ($ENV{HTTP_USER_AGENT}||'') =~/MSIE/;
}
elsif (exists $m->{-asize}) { # Textfield
$wgp =$s->cgi->textfield(
($cs ? (-class=>$cs) : ())
,(map { $_ ne '-asize'
? ($_=>ref($m->{$_}) ne 'CODE'
? $m->{$_}
: &{$m->{$_}}($s,$m,local($_)=$v))
: ('-size'=>do {
my $z =$m->{-asize};
$z =(ref($z) ne 'CODE'
? $z
: &$z($s,$m,local($_)=$v)) ||20;
my $l =defined($v) ? length($v) : 0;
$l < $z ? $z : $l >80 ? 80 : $l;
})
} keys %$m)
,-name=>$n
,-title=>$t
,-override=>1
,-default=>$v)
}
elsif ($m->{-values} ||$m->{-labels}) { # Listbox
my $tv =$m->{-values};
$tv =&$tv($s) if ref($tv) eq 'CODE';
my $tl =$s->lngslot($m, '-labels');
$tl =&$tl($s) if ref($tl) eq 'CODE';
$tv =do{use locale; [sort {$tl->{$a} cmp $tl->{$b}} keys %$tl]}
if !$tv && $tl;
unshift @$tv, $v if defined($v) && ($v ne '') && !grep {$_ eq $v} @$tv;
unshift @$tv, '' if $s->{-pcmd}->{-cmg} eq 'recQBF';
$wgp =$s->cgi->popup_menu(
($cs ? (-class=>$cs) : ())
,($m->{-ddlbloop} ? !ref($m->{-ddlbloop}) || &{$m->{-ddlbloop}}($s) : 0)
||($m->{-loop} ? !ref($m->{-loop}) || &{$m->{-loop}}($s) : 0)
? (-onchange => '{window.document.DBIx_Web._cmd.value="recForm"; window.document.DBIx_Web.submit(); return(false)}')
: ()
,(map { !defined($m->{$_}) || ($_=~/^(?:-ddlbloop|loop)$/)
? ()
: ref($m->{$_}) eq 'CODE'
? (do { my $n =$_; local $_ =$v;
($n => &{$m->{$n}}($s,$m,$_))
})
: ($_ => $m->{$_})} keys %$m)
,-name=>$n, -title=>$t
, $tv ? (-values=>$tv) : ()
, $tl ? (-labels=>$tl) : ()
,-override=>1,-default=>$v)
}
elsif ($m->{-rfd}) { # RFD Filebox
$wgp =$s->htmlRFD()
}
else { # Textfield
$wgp =$s->cgi->textfield(
($cs ? (-class=>$cs) : ())
,(map {($_ => (ref($m->{$_}) eq 'CODE'
? &{$m->{$_}}($s,$m,local($_)=$v)
: $m->{$_}))} keys %$m)
,-name=>$n,-title=>$t,-override=>1,-default=>$v)
}
}
elsif (ref($m) eq 'CODE') { # Any other...
$wgp =&$m(@_)
}
$wgp
}
sub trURLtxt { # Translate text with URLs
# (text, sub{} txt, sub{} url) -> txt || [url]
# !!! restricted -cgibus special urls translation:
# _tcb_cmd= -> _cmd=
# =-sel -> =recRead
# -> _form=...
# id= -> _key=...
my($s, $vt, $ct, $cu) =@_;
my $vr=$ct ? '' : [];
my $f;
while ($vt =~/(\[{2}[\w-]{3,7}:\/\/[^\n\r]+?\]{2}|\b[\w-]{3,7}:\/\/[^\s\t,()<>\[\]"']+[^\s\t.,;()<>\[\]"'])/) {
my($u0,$u,$u1) =($1,$1);
$vt =$';
$vr .=&$ct($s,$`) if !ref($vr);
if ($u =~/^\[{2}(.+?)\]{2}$/) {
$u =$u0 =$1;
if ($u =~/(?:\]\[|[|])/) {
$u =$`; $u1 =$'; $u0 =$u
}
$u =$u0 =htmlEscape($s,$u) if $u =~/\s/;
}
if ($s->{-cgibus} && ($u =~/^(?:url|urlr):/)) {
$u =~s/_tcb_cmd=-sel/'_cmd=recRead&_form=' .$s->{-pcmd}->{-form}/ge;
lib/DBIx/Web.pm view on Meta::CPAN
: $a =~/[&.]/ ? $IMG->{'frmCall'}
: $IMG->{'recList'}
) .'" />')
. $s->htmlEscape($l0))
: $s->htmlEscape($l)
, "</nobr></th>\n"
, '<td> </td><td align="left" valign="bottom">'
, $s->htmlEscape( !$l1 || $l1 ne $l0
? $l1||''
: 1
? $l1||''
: $a =~/[+]/
? $s->lng(0,'frmCallNew') ." '$l0'"
: $a =~/[&.]/
? $s->lng(0,'frmCallOpn') ." '$l0'"
: $s->lng(0,'frmCallOpn') ." '$l0'"
)
, "</td></tr>\n"
)
}
$s->output("\n</table>\n");
# $s->recCommit();
$s->cgiFooter() if !$s->{-pcmd}->{-print};
$s->output($s->htmlEnd());
$s->end();
}
,@_ > 1 ? @_[1..$#_] : ()
})
}
sub tvdFTQuery { # Template View Definition for Full-Text Query
my $s =$_[0]; return ($s->{-tn}->{'tvdFTQuery'}=>
{-lbl =>sub{$_[0]->lng(0,'tvdFTQuery')}
,-cmt =>sub{$_[0]->lng(1,'tvdFTQuery')}
,-cgcCall =>sub{
my $s =$_[0];
my $g =$s->cgi();
$s->{-fetched} =0;
$s->{-affected} =undef;
$s->{-pcmd}->{-cmd} =$s->{-pcmd}->{-cmg} ='recQBF';
$s->output($s->htmlStart(@_[1,2]) # HTTP/HTML/Form headers
,$s->htmlHidden(@_[1,2]) # common hidden fields
,!$s->{-pcmd}->{-print}
&& $s->htmlMenu(@_[1,2]) # Menu bar
,"\n"
);
$s->die('Microsoft IIS required') if ($ENV{SERVER_SOFTWARE}||'') !~/IIS/;
$s->die('Impersonation required') if (($ENV{GATEWAY_INTERFACE}||'') =~/PerlEx/i)
&& ($s->{-c}->{-RevertToSelf}
||$s->w32ufswtr());
$g->param('_qftwhere'
, defined($g->param('_qftwhere')) && ($g->param('_qftwhere') ne '')
? $g->param('_qftwhere')
: defined($g->param('_qftext')) && ($g->param('_qftext') ne '')
? $g->param('_qftext')
: '');
$s->output($g->textfield(-name=>'_qftwhere', -size=>70, -title=>$s->lng(1,'-qftwhere'))
, '<br />'
, $g->popup_menu(-name=>'_qftord'
,-values=>['write','hitcount','vpath','docauthor']
,-labels=>{
'write' =>'Chronologically'
,'hitcount' =>'Ranked'
,'vpath' =>'by Name'
,'docauthor' =>'by Author'
}
,-default=>'write')
, $g->popup_menu(-name=>'_qlimit'
,-values=>['',128,256,512,1024,2048,4096]
,-labels=>{
'' =>"$LIMRS default"
,128 =>'128 max'
,256 =>'256 max'
,512 =>'512 max'
,1024=>'1024 max'
,2048=>'2048 max'
,4096=>'4096 max'
}
,-default=>$LIMRS)
, $g->submit(-name =>'tvdFTQuery_'
,-value=>$s->lng(0,'recList')
,-title=>$s->lng(1,'recList'))
, '' && $g->a({-href=>
-e ($ENV{windir} .'/help/ix/htm/ixqrylan.htm')
? '/help/microsoft/windows/ix/htm/ixqrylan.htm'
: '/help/microsoft/windows/isconcepts.chm' # .'::/ismain-concepts_30.htm'
}, '?')
, "<br />\n");
if ($g->param('_qftwhere') ne '') {
eval('use Win32::OLE; Win32::OLE->Option("Warn"=>0)');
Win32::OLE->Initialize();
# Win32::OLE->Initialize(&Win32::OLE::COINIT_OLEINITIALIZE);
# Search MSDN for 'ixsso.Query'
my $oq =Win32::OLE->CreateObject("ixsso.Query");
!$oq && $s->die("'OLE->CreateObject(ixsso.Query)' failed '$!'/'$@'/" .Win32::OLE->LastError);
my $ou =Win32::OLE->CreateObject("ixsso.util");
!$oq && $s->die("'OLE->CreateObject(ixsso.util)' failed '$!'/'$@'/" .Win32::OLE->LastError);
my $qs =[];
my $qt =[];
$oq->{Query} =$g->param('_qftwhere') =~/^(@\w|\{\s*prop\s+name\s+=)/i
? $g->param('_qftwhere')
: ('@contents ' .$g->param('_qftwhere'));
$oq->{Catalog} ='Web';
$oq->{MaxRecords} =$g->param('_qlimit') ||$LIMRS;
$oq->{MaxRecords} =4096 if $oq->{MaxRecords} >4096;
$oq->{SortBy} =$g->param('_qftord') ||'write';
$oq->{SortBy} .=$oq->{SortBy} =~/^(write|hitcount)$/i
? '[d],docauthor[a]'
: '[a],write[d]';
$oq->{Columns} ='vpath,path,filename,hitcount,write,doctitle,docauthor,characterization';
$oq->{LocaleID} =1049; # ru
my $ol =eval {$oq->CreateRecordset('sequential')}; # 'nonsequential'
!$oq && $s->die("'OLE->CreateRecordset(sequential)' failed '$!'/'$@'/" .Win32::OLE->LastError);
$s->output('No records found') if $ol->{EOF};
my ($rcf, $rct, $rcd) =(0, 0, 0);
while (!$ol->{EOF}) {
my $vp =$ol->{vPath}->{Value};
$rcf +=1;
if (!$vp) {
$rct +=1;
}
if ($vp) {
$rcd +=1;
my $vt =$g->escapeHTML($ol->{DocTitle}->{Value});
$vt = ($vt ? '$vt' .' ' : '')
( run in 0.725 second using v1.01-cache-2.11-cpan-364913b4093 )