Name

file-navigator —

ATTRIBUTES

Attribute Pos. Req. Default Description
base_url
view_href
view_form
edit_page
edit_form
initial_dir
details
edit_only
edit_all
top_of_tree
no_up
parent_directory_message
no_new_file
no_dirs
template
interpolate     0 interpolate output?
hide     0 Hide the tag return value?

DESCRIPTION

BEHAVIOR

This tag appears to be affected by, or affects, the following:
Catalog Variables: UI_BASE
Global Variables: MV_PAGE

EXAMPLES

No examples are available at this time. We do consider this a problem and will try to supply some.

NOTES

AVAILABILITY

file-navigator is available in Interchange versions:

4.6.0-5.7.0 (git-head)

SOURCE

Interchange 5.7.0:

Source: code/UI_Tag/file_navigator.coretag
Lines: 345


# 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

AUTHORS

Interchange Development Group

SEE ALSO

DocBook! Interchange!