CGI-Bus
view release on metacpan or search on metacpan
lib/CGI/Bus/wg.pm view on Meta::CPAN
$r .=join('; '
,map {$s->a({-href=>$_, -target=>'_blank', -title=>$_}
,$s->htmlescape(length() >49 ? substr($_,0,47) .'...' : $_))
} @h);
$r .='<br />' if $r;
delete $a{-hrefs};
}
$r .=$s->cgi->textarea(%a);
$r .=$r1;
$r
}
sub fsdir { # Filesystem dir field
# name,edit,path,URL,URF,rows,cols
my ($s, $nm, $ed, $ea, $fp, $fu, $fr, $sr, $sc) =@_;
my $x; if (ref($nm)) {$x =$nm; $nm =$x->{-name}};
my $p =$s->parent;
my ($nml, $nma, $nmu, $nmc, $nmo) =("${nm}_l", "${nm}_d", "${nm}_u", "${nm}_c", "${nm}_o");
my $r =$p->cgi->a({-href=>$fr||$fu,-target=>'_blank',-title=>$p->htmlescape($s->lng(1,'Files'))}
, $p->{-iurl}
? ('<img border="0" src="' .$p->{-iurl} .'/folder.open.gif" />')
: ('<strong>' .$p->htmlescape($s->lng(0,'Files')) ." </strong>")
) ."\n";
my $fo=undef;
$s->_fsclose($fp, [$p->cgi->param($nmc)])
if $ed && $p->cgi->param($nmc);
$fo = $ed && ($p->cgi->param($nmc)||$p->cgi->param($nmo)) && $s->_fsopens($fp,{});
if (1 && $p->urfcnd && $ed && $fr) {
$r .=$p->cgi->submit(($x ? (%$x) : ())
,-name=>$nmo
,-value=>$s->lng(0,'fsopens')
,-title=>$s->lng(1,'fsopens')) ."\n"
if !$fo && $^O eq 'MSWin32';
$r .="<br />"
.$p->cgi->scrolling_list(($x ? (%$x) : ())
, -name=>$nmc, -override=>1, -multiple=>'true'
, -values=> ['---' .$s->lng(0,'fsclose') .'---'
,ref($fo) eq 'HASH' ? sort keys %$fo : @$fo]
, ref($fo) eq 'HASH' ? (-labels=>$fo) : ()
)
.$p->cgi->submit(($x ? (%$x) : ())
,-name=>$nma
,-value=>$s->lng(0,'fsclose')
,-title=>$s->lng(1,'fsclose')) ."\n"
if $fo;
if ($ed && $fr && $fr =~/^file:(.*)/i) {
my $fs =$1; $fs =~s/\//\\/g;
$r .='<span style="font-size: smaller;" '
#.' onclick="window.event.srcElement.select" '
#.' ondblclick="{window.clipboardData.setData(\'Text\',' .$p->htmlescape($fs) .'\'); return(false)}" '
# window.event.srcElement
# document.selection.empty();
.' title="' .$p->htmlescape($s->lng(1,'Files') .' ') .'" '
.'><sub>'
.$p->htmlescape($fs) ."</sub></span>"
}
$r .="<br />\n";
# !!! filefield may be useful to attach files, but file creation time will not be saved !!!
# $r .=$p->cgi->filefield(-name=>$nmu);
# $s->_fsdirupload($nmu, $fp) if $ea && $p->cgi->param($nmu);
$r .='<iframe scrolling="auto" src="' .$p->htmlescape($fr) .'"';
$r .=' application="yes"';
$r .=' height="' .$sr .'"' if $sr;
$r .=' width="' .$sc .'"' if $sc;
$r .='> </iframe>';
return $r;
}
my $fb =$p->urfcnd && $ed ? ($fr ||$fu) : ($fu ||$fr);
if (!$ed) {
my $fl =join(",\n"
, map {$p->cgi->a({-href=>"$fb/$_", -target=>'_blank'
}, $p->htmlescape($_))}
eval{$p->fut->globn("$fp/*")}
);
$r .=$fl ."\n" if $fl;
my $fd;
if ($fd =$p->orarg('-f',"$fp/index.html","$fp/index.htm")) {
my $fn =($fd =~/([^\\\/]+)$/ ? $1 : $fd);
# $fd ='<embed scr="' ."$fb/$fn" .'" height=100% width=100% />';
# $fd ='<iframe scroling="auto" src="' .$p->htmlescape("$fb/$fn") .'" width=100% height=100%></iframe>';
$fd =$p->fut->fload('-b',$fd);
$fd =$' if $fd =~m/<body\b[^>]*>/i;
$fd =$` if $fd =~m/<\/body\b/i;
$fd ='<base href="' .($fb =~/:\/\// ? $fb : $p->surl($fb)) .'/" />' .$fd if $fd !~m/<base\b/i; # !!! May be a problem
$r .='<hr />' .$fd .'<br />';
}
}
elsif ($ed) {
$s->_fsdirupload($nmu, $fp) if $ea && $p->cgi->param($nmu);
if ($ea && $p->cgi->param($nma)) {
foreach my $fn ($p->cgi->param($nml)) {
$p->fut->delete('-r',"$fp/$fn");
}
}
$r .=$p->cgi->filefield(($x ? (%$x) : ()), -name=>$nmu, -title=>$s->lng(1,'fsbrowse'));
$r .=$p->cgi->submit(($x ? (%$x) : ()), -name=>$nma, -value=>$s->lng(0,'+|-'), -title=>$s->lng(1,'+|-'));
$r .=$p->cgi->submit(($x ? (%$x) : ()), -name=>$nmo, -value=>$s->lng(0,'fsopens'), -title=>$s->lng(1,'fsopens'))
if !$fo && $^O eq 'MSWin32';
$r .=$p->cgi->scrolling_list(($x ? (%$x) : ())
, -name=>$nmc, -override=>1, -multiple=>'true'
, -values=> ['---' .$s->lng(0,'fsclose') .'---'
,ref($fo) eq 'HASH' ? sort keys %$fo : @$fo]
, ref($fo) eq 'HASH' ? (-labels=>$fo) : ()
) ."\n"
if $fo;
if ($ed && $fr && $fr =~/^file:(.*)/i) {
my $fs =$1; $fs =~s/\//\\/g;
$r .='<span style="font-size: smaller;" '
.' title="' .$p->htmlescape($s->lng(1,'Files') .' ') .'" '
.'><sub>'
.$p->htmlescape($fs) ."</sub></span>"
}
$r .="<br />\n"; # $r .="\n \n";
foreach my $fn (eval{$p->fut->globn("$fp/*")}) {
$r .=$p->cgi->a({-href=>"$fb/$fn", -target=>'_blank'}
,$p->cgi->checkbox(($x ? (%$x) : ()), -name=>$nml, -value=>$fn, -label=>$fn, -title=>$s->lng(1,'fsdelmrk')))
." \n";
}
}
$r
}
sub _fsdirupload { # Filesystem dir field file upload
my ($s, $nmu, $fp) =@_;
my $fa =$s->cgi->param($nmu);
if ($fa) {
my $fn =$fa =~/[\\\/]([^\\\/]+)$/ ? $1 : $fa;
my $fh =$s->cgi->upload($nmu);
if ($fh) {
$s->pushmsg("upload '$fn' from '$fa'");
binmode($fh);
eval('use File::Copy');
File::Copy::copy($fh, "$fp/$fn")
||$s->die("Upload '$fn' from '$fa': $!\n");
close($fh);
}
else {
$s->die("Empty filehandle '$fn' from '$fa': " .($!||$@||'') ."\n");
}
}
}
sub _fsopens { # opened files (`net file`; NetFileEnum; IADsResource, IADsFileServiceOperations)
# (mask, ?container)
return(undef) if $^O ne 'MSWin32';
my $rc =$_[2]||[];
my $mask =$_[1]||''; $mask =~s/\//\\/ig;
my $o =eval('use Win32::OLE; Win32::OLE->Option("Warn"=>0); Win32::OLE->GetObject("WinNT://'
.(eval{Win32::NodeName()}||$ENV{COMPUTERNAME}) .'/lanmanserver")');
return(undef) if !$o;
if (ref($rc) eq 'HASH') {
%$rc =map {(substr($_->{Path}, length($mask)+1), $_->{User} .': ' .substr($_->{Path}, length($mask)+1))
} grep {(eval{$_->{Path}}||'') =~/^\Q$mask\E/i
} Win32::OLE::in($o->Resources());
# %$rc =(1=>'1.1',2=>'2.1',3=>'3.1');
$rc =undef if !%$rc
}
else {
@$rc =map {eval{substr($_->{Path}, length($mask)+1)}
} grep {(eval{$_->{Path}}||'') =~/^\Q$mask\E/i # $_->GetInfo;
} Win32::OLE::in($o->Resources());
$rc =undef if !@$rc
}
$rc
}
sub _fsclose { # close opened files (`net file /close`)
# (mask, [files])
return(0) if $^O ne 'MSWin32';
my $mask =$_[1]||''; $mask =~s/\//\\/ig;
my $list =$_[2]||[];
my $o =eval('use Win32::OLE; Win32::OLE->Option("Warn"=>0); Win32::OLE->GetObject("WinNT://'
.(eval{Win32::NodeName()}||$ENV{COMPUTERNAME}) .'/lanmanserver")');
return(0) if !$o;
foreach my $f (grep {$_ && (eval{$_->{Path}}||'')=~/^\Q$mask\E/i
} Win32::OLE::in($o->Resources())) {
my $n =eval{$f->{Path} =~/^\Q$mask\E[\\\/]*(.+)/i ? $1 : undef};
next if !$n || !grep /^\Q$n\E$/i, @$list;
$_[0]->oscmd('net','file',$f->{Name},'/close');
}
1
}
( run in 1.396 second using v1.01-cache-2.11-cpan-b16cb0d3907 )