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')) ."&nbsp;&nbsp;&nbsp;</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&nbsp;&nbsp;&nbsp;\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')))
          ."&nbsp;&nbsp;&nbsp;\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 )