# Copyright 2002-2007 Interchange Development Group and others
# 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.  See the LICENSE file for details.
# 
# $Id: file_navigator.coretag,v 1.17 2007-12-21 03:32:43 mheins Exp $

UserTag file-navigator Order    mask
UserTag file-navigator addAttr
UserTag file-navigator Version  $Revision: 1.17 $
UserTag file-navigator Routine  <<EOR
use vars qw/$CGI $Session $Tag $Scratch/;
eval {
        require Fcntl;
		local($^W) = 0;
        import Fcntl qw/:mode/;
};
if ($@) {
        *S_ISUID = sub {return 2048};
        *S_ISGID = sub {return 1024};
        *S_ISVTX = sub {return 512};
}
sub {
	my ($dir_mask, $opt) = @_;


#::logDebug("file-nav dir_mask: $dir_mask opt: " . ::uneval($opt));
    $dir_mask = '*';

	my $base_admin = ( $::Variable->{UI_BASE} || 'admin');
	my $base_url = $Vend::Cfg->{VendURL}
				. '/'
				. ($opt->{base_url} || $base_admin);
	my $view_href = $opt->{view_href} || "$base_admin/do_view";
	my $view_form = $opt->{view_form} || 'mv_arg=~FN~';
	my $full_path;
	my $action = $CGI::values{action} || '';
	my $already_found;

	my $edit_page = $opt->{edit_page} || "content_editor";
	my $edit_form = $opt->{edit_form} || "ui_name=~FN~&ui_type=page";
	
	my @errors;
	my @messages;

	my $idir_re;
	if ($opt->{initial_dir}) {
		$Vend::Session->{ui_cwd} = $opt->{initial_dir};
		$idir_re = qr{^$opt->{initial_dir}/};
	}

	if($action eq 'chdir') {
		my $newdir = $CGI::values{dir} || '.';
		unless( Vend::File::allowed_file($newdir) ) {
			$Scratch->{ui_error} = ::errmsg('Security violation');
			return interpolate_html("[bounce page='$base_admin/error']");
		}
		if(! -d $newdir) {
			$Scratch->{ui_error} = ::errmsg("%s not a directory", $newdir);
			return interpolate_html("[bounce page='$base_admin/error']");
		}
		$Vend::Session->{ui_cwd} = $newdir || '.';
	}

	my $curdir = $Vend::Session->{ui_cwd} || '.';
	$curdir =~ s:/+$::;
	my @files;

	FINDNAV: {
		if($action eq 'find') {
			my $regex;
			my $string = $CGI::values{find};
			if($string !~ /\S/) {
				push @errors, ::errmsg("Refuse to find a blank or whitespace.");
				last FINDNAV;
			}
			elsif( $string =~ /\(\s*\?\s*\{/) {
				$Scratch->{ui_error} = ::errmsg('Security violation');
				return interpolate_html("[bounce page='$base_admin/error']");
			}
			else {
				eval {
					if($string =~ /\*/ and $string !~ /\.\*/) {
						$regex =~ s/\*/.*/g;
					}
					$regex = qr{$string};
				};
			}

			if($@ or ! $regex) {
				push @errors, ::errmsg("%s is not a good search.", $regex);
				last FINDNAV;
			}

			$full_path = 1;
			require File::Find;
			my $wanted;

			local($SIG{__WARN__}) = sub { push @errors, $_ };

			my %exclude;
			if($CGI::values{find_action} =~ /\bfilename\b/) {
				$wanted = sub {
					push @files, $File::Find::name
						if $_ =~ $regex;
				};
			}
			else {
				if($curdir eq '.' and ! $CGI::values{find_session}) {
					%exclude = (qw! ./session 1 session 1 tmp 1 ./tmp 1!);
				}
				$wanted = sub {
					local ($/) = undef;
					if( -d $_ and $exclude{$File::Find::dir}) {
						$File::Find::prune = 1;
						return;
					}
					return unless -f _;
					-s _ > 1_000_000
						and do {
							push(@errors,
								errmsg("%s: refuse to find in megabyte-sized files",
										$File::Find::name)
								);
							return;
						};
					open(TMPFINDNAV, "< $_")
						or do {
							push(@errors,
								errmsg("%s: permission denied", $File::Find::name)
								);
							return;
						};
					my $str = <TMPFINDNAV>;
					$str =~ $regex
						and push (@files, $File::Find::name);
					return;
				};
			}
			File::Find::find($wanted, $curdir);

			 s:^./:: for @files;

			if(@files) {
				push @messages, errmsg("Found %s files.", scalar @files);
				$already_found = 1;
			}
			else {
				undef $full_path;
				push @errors, errmsg("No files found.");
			}
		}
	}

	if($already_found) {
		# do nothing
	}
	elsif($curdir eq '.') {
		if($dir_mask eq '*') {
			@files = grep $_ ne 'CVS', glob('*');
		}
		else {
			@files = split /\s+/, $dir_mask;
		}
	}
	else {
		@files = grep $_ !~ m{/CVS$}, glob("$curdir/*");
	}

	my $this_page = $Global::Variable->{MV_PAGE};
	my $this = Vend::Interpolate::tag_area($this_page);
	$this =~ s/\?(.*)//;

	my $up_img = qq{<img src="up.gif" align=center border=0 height=22 width=20 title="upload ~FN~">};
	my $dn_img = qq{<img src="down.gif" align=center border=0 height=22 width=20 title="download ~FN~">};
	my $vw_img = qq{<img src="index.gif" align=center border=0 height=22 width=20 title="view ~FN~">};
	my $ed_img = qq{<img src="layout.gif" align=center border=0 height=22 width=20 title="edit ~FN~">};
	my $dir_img = qq{<img src="folder.gif" align=center border=0 height=22 width=20 title="change directory to ~FN~">};
	my $del_img = qq{<img src="delete.gif" align=center border=0 height=20 width=20 title="DELETE ~FN~">};
	my $sp_img = qq{<img src="bg.gif" align=center border=0 height=20 width=20>};

	my $do_perms;
	$opt->{details} = $CGI->{details} unless defined $opt->{details};
	if(defined $opt->{details}) {
		$do_perms = $opt->{details};
	}
	elsif (defined $CGI->{details}) {
		$do_perms = $Session->{ui_file_details} = $CGI->{details};
	}
	else {
		$do_perms = $Session->{ui_file_details};
	}

	my $del_string = '';
	$Tag->if_mm('advanced', 'delete_files')
		and do {
			$del_string = qq{<A onClick="return confirm('Are you sure you want to delete the file ~FN~?')" HREF="$Vend::Cfg->{VendURL}/$this_page?~ID~&mv_click=file_maintenance&ui_delete_file=~FN~&mv_action=back">$del_img</A>};
		};

	my $ftmpl = <<EOF;
<A HREF="$Vend::Cfg->{VendURL}/ui_download/~FN~?~ID~">$dn_img</A>$del_string<A HREF="$base_url/upload_file?~ID~&mv_arg=~FN~&ui_return_to=$this_page">$up_img</A><A HREF="$base_url/do_view?~ID~&mv_arg=~FN~">$vw_img</A>&nbsp;%s&nbsp;<A HREF="$Vend::Cfg->{VendURL}/$view_href?~ID~&$view_form">%s</A><BR>
EOF

	my $utmpl = <<EOF;
<A HREF="$base_url/upload_file?~ID~&mv_arg=~FN~&ui_return_to=$this_page">$up_img</A>&nbsp;%s&nbsp;<A HREF="$base_url/upload_file?~ID~&mv_arg=~FN~&ui_return_to=$this_page">%s</A><BR>
EOF

	my $ftmpl_ed;
	if(! $do_perms and $opt->{edit_only}) {
		$ftmpl_ed = <<EOF;
<A HREF="$base_url/$edit_page?~ID~&$edit_form&ui_return_to=$this_page">$ed_img</A>&nbsp;%s&nbsp;<A HREF="$base_url/$edit_page?~ID~&$edit_form&ui_return_to=$this_page">%s</A><BR>
EOF
	}
	else {
		$ftmpl_ed = <<EOF;
<A HREF="$Vend::Cfg->{VendURL}/ui_download/~FN~?~ID~">$dn_img</A>$del_string<A HREF="$base_url/upload_file?~ID~&mv_arg=~FN~&ui_return_to=$this_page">$up_img</A><A HREF="$base_url/$edit_page?~ID~&$edit_form&ui_return_to=$this_page">$ed_img</A>&nbsp;%s&nbsp;<A HREF="$base_url/$edit_page?~ID~&$edit_form&ui_return_to=$this_page">%s</A><BR>
EOF
	}

	my $dtmpl = <<EOF;
<A HREF="$Vend::Cfg->{VendURL}/$this_page?~ID~&action=chdir&dir=~FN~">$dir_img</A>&nbsp;%s&nbsp;<A HREF="$Vend::Cfg->{VendURL}/$this_page?~ID~&action=chdir&dir=~FN~">%s</A><BR>
EOF

	$dtmpl = "$sp_img$sp_img$sp_img$dtmpl" if $do_perms;

	my @out;
	my $out;
	
	my @dir;
	my @plain;


	sub perm_line {
		my $fn = shift;

		my @perm = qw/
			---
			--x
			-w-
			-wx
			r--
			r-x
			rw-
			rwx
		/;

		my @det;
		if (-l $fn) {
			@det = lstat($fn);
		}
		else {
			@det = stat(_);
		}
		my $time = POSIX::strftime("%d-%b-%Y %H:%M:%S", localtime($det[9]));
		my $permstring = sprintf('%04o', $det[2]);
		#push @messages, "$_ perms=$permstring\n";
		$permstring = substr($permstring, -3, 3);
		my $top;
		my (@ugo) = split //, $permstring;
		@ugo = map { $_ = $perm[$_] } @ugo;
		if    (-l _) { $top = 'l' }
		elsif (-d _) { $top = 'd' }
		elsif (-f _) { $top = '-' }
		else         { $top = '?' }
		$ugo[0] =~ s/.$/s/ if $det[2] & S_ISUID();
		$ugo[1] =~ s/.$/s/ if $det[2] & S_ISGID();
		$ugo[2] =~ s/.$/t/ if $det[2] & S_ISVTX();
		my $user = getpwuid($det[4]);
		my $grp  = getgrgid($det[5]);
		$grp = substr($grp, 0, 8) if length($grp) > 8;
		$user = substr($grp, 0, 8) if length($user) > 8;
		my $perm = join "", $top, @ugo;
		my $ret = sprintf(" <TT><SMALL>%s %-8s %-8s %s</SMALL></TT>", $perm, $user, $grp, $time);
		$ret =~ s/ /&nbsp;/g;
		return $ret;
	}

	my $perms = '';
	for(@files) {
		my $fn = $_;
		$fn =~ s:.*/::
			unless $full_path;
		my $fe = $_;
		$fe =~ s!([^-\w./:,])!sprintf('%%%02x', ord($1) )!eg;
		my $perms;
		$perms = perm_line($_) if($do_perms);
		
		if(-d $_) {
			push @dir, [$fe, $fn, $dtmpl, $perms];
		}
		elsif ($opt->{edit_all} || ($opt->{edit_only} && /\.html?$/) ) {
			my $rn = $curdir . "/$fn";
			$rn =~ s{$idir_re}{} if $idir_re;
			push @plain, [$fe, $fn, $ftmpl_ed, $perms, $rn];
		}
		else {
			push @plain, [$fe, $fn, $ftmpl, $perms];
		}
	}

	$opt->{top_of_tree} ||= '.';
	my $nd = $curdir;
	if($nd ne $opt->{top_of_tree} and ! $opt->{no_up}) {
		$nd =~ s:/[^/]*$::
		  or $nd = $opt->{top_of_tree};
		my $msg = '<large><b>..</b></large> &#91;'
		  . errmsg ($opt->{parent_directory_message} || 'parent directory')
			. '&#93;';
		unshift @dir, [ $nd, $msg, $dtmpl ];
	}

	my $pc = \$Vend::Session->{pageCount};
	unshift @dir, [ "$curdir/", errmsg('(new file)'), $utmpl ]
		unless $opt->{no_new_file};

	@dir = () if $opt->{no_dirs};

	for(@errors) {
		$out .= "<span class=cerror>$_</span><br>";
	}
	for(@messages) {
		$out .= "<span class=cmessage>$_</span><br>";
	}
	my $template = $opt->{template} || '';
	for (@dir, @plain) {
		$$pc++;
		$_->[2] = sprintf($_->[2], $_->[3], $_->[1]);
		$_->[2] =~ s/~FN~/$_->[0]/g;
		$_->[2] =~ s/~RN~/$_->[4]/g;
		$_->[2] =~ s/~ID~/mv_session_id=$Session->{id}&mv_pc=$$pc/g;
		if($template) {
			my $t = $template;
			$t =~ s/%s/$_->[2]/;
			$out .= $t;
		}
		else {
			$out .= $_->[2];
		}
	}

	return $out;
}
EOR
