view release on metacpan or  search on metacpan

lib/App/GitFind/FileStatLs.pm  view on Meta::CPAN

=cut

sub format_mode {
    my $s = ref($_[0]) ? shift : (App::GitFind::FileStatLs->new);
    my $mode = shift;
    my %opts = @_;

    my @perms = qw(--- --x -w- -wx r-- r-x rw- rwx);
    my @ftype = qw(. p c ? d ? b ? - ? l ? s ? ? ?);
    $ftype[0] = '';
    my $setids = ($mode & 07000)>>9;
    my @permstrs = @perms[($mode&0700)>>6, ($mode&0070)>>3, $mode&0007];
    my $ftype = $ftype[($mode & 0170000)>>12];

    if ($setids) {
      if ($setids & 01) {         # Sticky bit
        $permstrs[2] =~ s/([-x])$/$1 eq 'x' ? 't' : 'T'/e;
      }
      if ($setids & 04) {         # Setuid bit
        $permstrs[0] =~ s/([-x])$/$1 eq 'x' ? 's' : 'S'/e;
      }
      if ($setids & 02) {         # Setgid bit
        $permstrs[1] =~ s/([-x])$/$1 eq 'x' ? 's' : 'S'/e;
      }
    }

    join '', $ftype, @permstrs;
}

=head2 ls_stat ($fn)

Input variables:

  $fn - file name

Variables used or routines called:

  None

How to use:

   my $ls = ls_stat($fn);
   # NOT $self->ls_stat($fn) --- not supported

Return: the ls string such as one of the following:

  -r-xr-xr-x   1 root     other         4523 Jul 12 09:49 uniq
  drwxr-xr-x   2 root     other         2048 Jul 12 09:50 bin
  lrwxrwxrwx   1 oracle7  dba             40 Jun 12  2002 linked.pl -> /opt/bin/linked2.pl

The output B<includes> a trailing newline.

=cut

sub ls_stat {
    my $fn = shift;
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
        $atime,$mtime,$ctime,$blksize,$blocks) = lstat $fn;
    my $dft = "%b %d  %Y";
    my $ud = getpwuid($uid);
    my $gd = getgrgid($gid);
    my $fm = format_mode($mode);
    my $mt = strftime $dft,localtime $mtime;
    my $link_to = (($mode & S_IFLNK) == S_IFLNK ? " -> @{[readlink $fn]}" : "");
    my $fmt = "%10s %3d %7s %4s %12d %12s %-s%s\n";
    return sprintf $fmt, $fm,$nlink,$ud,$gd,$size,$mt,$fn,$link_to;
}

=head2 stat_attr ($fn, $typ)

Input variables:

  $fn - file name for getting stat attributes
     ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
      $atime,$mtime,$ctime,$blksize,$blocks) = stat($fn);
  $typ - what type of object that you want it to return.
    The default is to return a hash containing filename, longname,
    and a hash ref with all the element from stat.
    SFTP - to return a Net::SFTP::Attributes object

Variables used or routines called:

  ls_stat

How to use:

   my $hr = $self->stat_attr($fn);  # get hash ref
   my %h  = $self->stat_attr($fn);  # get hash

Return: C<$hr> or C<%h> where the hash elements depend on the type.
The default is to get a hash array with the following elements:

  filename - file name
  longname - the ls_stat string for the file
  a        - the attributes of the file with the following elements:
             dev,ino,mode,nlink,uid,gid,rdev,size,atime,mtime,
             ctime,blksize,blocks

If the type is SFTP, then it will only return a
L<Net::SFTP::Attributes> object with the following elements:

  flags,perm,uid,gid,size,atime,mtime

=cut

sub stat_attr {
    my $s = ref($_[0]) ? shift : (App::GitFind::FileStatLs->new);
    my ($fn,$typ) = @_;
    (require Carp, Carp::croak "ERR: no file name for stat_attr.\n") if ! $fn;
    return undef if ! $fn;
    my $vs  = 'dev,ino,mode,nlink,uid,gid,rdev,size,atime,mtime,';
       $vs .= 'ctime,blksize,blocks';
    my $v1  = 'flags,perm,uid,gid,size,atime,mtime';
    my $ls = ls_stat $fn;  chomp $ls;
    my @a = (); my @v = ();
    my $attr = {};
    if ($typ && $typ =~ /SFTP/i) {
        @v = split /,/, $v1;
        @a = (stat($fn))[1,2,4,5,7,8,9];
        %$attr = map { $v[$_] => $a[$_] } 0..$#a ;