view release on metacpan or  search on metacpan

lib/DBIx/Web.pm  view on Meta::CPAN

sub htmlRFD {	# RFD widget html
 my ($s, $n, $m, $c, $d) =@_;
     $n =$s->{-pcmd}->{-form} if !$n || $n=~/^\d*$/;
     $m =$s->{-form}->{$n}||$s->{-table}->{$n} if !$m;
     $c =$s->{-pcmd} if !$c;
     $d =$s->{-pout} if !$d;
 return('') if !$d->{-file};
 my  $edt=$s->{-pcmd}->{-edit} && $d->{-file} && $d->{-fupd};
 my  $pth=$s->rfdPath(-path=>$d->{-file});
 my  $urf=$s->rfdPath(-urf=>$d->{-file});
 my  $url=$s->rfdPath(-url=>$d->{-file});
 my  $fnu='_file_u';
 my  $fnc='_file_c';
 my  $fnf='_file_f';
 my  $fnl='_file_l';
 my  $fno='_file_o';
 my  $g =$s->cgi();
 my  $r ='';
 if ($edt && $s->cgi->param($fnu)) {	# Upload
	$s->rfaUpload($c, $d, $fnu);
 }
 if ($edt && $urf 			# Close
 &&  $s->cgi->param($fnc)) {
	$s->nfclose($pth, [$s->cgi->param($fnc)])
 }
 if ($edt && $s->cgi->param($fnf)) {	# Delete
	$s->rfaRm($c, $d, [$s->cgi->param($fnl)])
 }

 if ($edt) {				# Edit widget
	my $fo =($s->cgi->param($fno)||$s->cgi->param($fnc))
		&& $s->nfopens($pth,{});
	my $cs =$s->{-c}->{-htmlclass} ? 'Input ' .$s->{-c}->{-htmlclass} : 'Input';
	$r .=$s->cgi->filefield(-name=>$fnu
		,($cs ? (-class=>$cs) : ())
		, -title=>$s->htmlEscape($s->lng(1,'rfauplfld')))
	.$s->cgi->submit(-name=>$fnf
		,($cs ? (-class=>$cs) : ())
		, -value=>$s->lng(0,'rfaupdate')
		, -title=>$s->lng(1,'rfaupdate')
		, -style=>"width: 3em;")
	.(!$fo && $^O eq 'MSWin32'
		? $s->htmlSubmitSpl(-name=>$fno
			,($cs ? (-class=>$cs) : ())
			, -value=>$s->lng(0,'rfaopen')
			, -title=>$s->lng(1,'rfaopen')
			, -style=>"width: 2em;")
		: '')
	.($fo	? $s->cgi->scrolling_list(-name=>$fnc, -override=>1, -multiple=>'true'
			, -title=>$s->lng(1,'rfaopen')
			,($cs ? (-class=>$cs) : ())
			, -values=>	['--- ' .$s->lng(0,'rfaclose') .' ---'
					,ref($fo) eq 'HASH' ? sort keys %$fo : @$fo]
			, ref($fo) eq 'HASH' ? (-labels=>$fo) : ())
		: '');
	if ($urf && $urf =~/^file:(.*)/i) {
		my $fs =$1; $fs =~s/\//\\/g;
		$r .="\n<font style=\"font-size: smaller;\">[ <span "
		# .' onclick="window.event.srcElement.select" '
		# .' oncopy="{window.clipboardData.setData(\'Text\',\'' .$s->htmlEscape($fs) .'\'); return(false)}" '
		# window.event.srcElement
		# document.selection.empty(); 
		.' title="' .$s->htmlEscape($s->lng(1,'rfafolder') .' ') .'">'
		.$g->a({-href=>$urf, -target=>'_blank'}
				, $s->htmlEscape($fs))
		."</span> ]</font><br />\n";
	}
	else {
		$r .="\n&nbsp;&nbsp;&nbsp;\n"
	}
	my $v= eval{join('; ',
		map {	my $f =$_; $f=~s/([%])/uc sprintf("%%%02x",ord($1))/ge;
			'<input type="checkbox" name="' .$fnl .'" value="' 
			.$s->htmlEscape($_) .'" title="' .$s->htmlEscape($s->lng(1,'rfadelm'))
			.'"' .($cs ? ' class="' .$cs .'"' : '') .'/>'
			.'<a href="' .$s->htmlEscape("$url/$f") .'" target="_blank"'
			.' title="' .$s->htmlEscape($_) .'"'
			.($cs ? ' class="' .$cs .'"' : '') .'>'
			.$s->htmlEscape($_) .'</a>'
		} $s->pthGlobns($pth .'/*'))};
	$r .=(defined($v)
		? $v
		: ('<span class="ErrorMessage"><hr class="ErrorMessage" /><b>'
			.$s->htmlEscape($s->lng(0, 'Error')) .':</b> '
			.$s->htmlEscape($@)
			."</b></span>\n"))
 }
 else	{				# View widget
	my $v =eval{join('; ',
		map {	my $f =$_; $f=~s/([%])/uc sprintf("%%%02x",ord($1))/ge;
			$_ eq '.htaccess'
			? ()
			: ($g->a({-href=>"$url/$f",-target=>'_blank'}
				, $s->htmlRFDimg($_,$pth,$url)
				. $s->htmlEscape($_)))
		} $s->pthGlobns($pth .'/*'))};
	$r .=' '
		.(defined($v)
		? $v
		: ('<span class="ErrorMessage"><hr class="ErrorMessage" /><b>'
			.$s->htmlEscape($s->lng(0, 'Error')) .':</b> '
			.$s->htmlEscape($@)
			."</b></span>\n"))
 }
 $r
}


sub htmlRFDimg { # RFD item image HTML
 my ($s,$f,$d,$u) =@_;	# (file, directory, url) -> img tag
 return('') if !$s->{-icons};
 my $p ="$d/$f";
 '<img border=0  align="bottom" height="16"'
.' src="'
.( -d $p
 ? $s->{-icons} .'/' .'dir.gif'
 : 0 && ($f =~/\.(?:gif)$/)
 ? $u .'/' .$f
 : ($s->{-icons} .'/' .(
   (-x $p) || ($f=~/\.(?:bin|com|cpl|exe|sys)$/i)