package File::Stat::Ls;

# Perl standard modules
use strict;
use warnings;
use Carp;
use POSIX qw(strftime);


require 5.003;
my $VERSION = 0.10;

require Exporter;
our @ISA         = qw(Exporter);
our @EXPORT      = qw(ls_stat format_mode);
our @EXPORT_OK   = qw(ls_stat format_mode
    );
our %EXPORT_TAGS = (
    all  => [@EXPORT_OK]
    );
our @IMPORT_OK   = qw(
    );

=head1 NAME

File::Stat::Ls - Perl class for converting stat to ls -l format 

=head1 SYNOPSIS

  use File::Stat::Ls;

  my $obj = File::Stat::Ls->new;
  my @a = statstat('/file/name.txt'); 
  my $ls = $obj->ls_stat(@a);

=head1 DESCRIPTION

This class contains methods to convert stat elements into ls format.
It exports two methods: I<format_mode> and I<ls_stat>. 
The I<format_mode> is borrowed from I<Stat::lsMode> class by 
Mark_Jason Dominus. The I<ls_stat> will build a string formated as
the output of 'ls -l'.

=cut

=head2 new ()

Input variables:

  None

Variables used or routines called:

  None

How to use:

   my $obj = new File::Stat::Ls;      # or
   my $obj = File::Stat::Ls->new;     # or

Return: new empty or initialized File::Stat::Ls object.

=cut

sub new {
    my $caller        = shift;
    my $caller_is_obj = ref($caller);
    my $class         = $caller_is_obj || $caller;
    my $self          = bless {}, $class;
    my %arg           = @_;   # convert rest of inputs into hash array
    foreach my $k ( keys %arg ) {
        if ($caller_is_obj) {
            $self->{$k} = $caller->{$k};
        } else {
            $self->{$k} = $arg{$k};
        }
    }
    return $self;
}

=head1 METHODS

This class defines the following common methods, routines, and 
functions.

=head2 Exported Tag: All 

The I<:all> tag includes all the methods or sub-rountines 
defined in this class. 

  use File::Stat::Ls qw(:all);

It includes the following sub-routines:

=cut

# ------ partial inline of Stat::lsMode v0.50 code
# (see http://www.plover.com/~mjd/perl/lsMode/
# for the complete module)
#
#
# Stat::lsMode
#
# Copyright 1998 M-J. Dominus
# (mjd-perl-lsmode@plover.com)
#
# You may distribute this module under the same terms as Perl itself.
#
# $Revision: 1.2 $ $Date: 2004/08/05 14:17:43 $

=head2 format_mode ($mode)

Input variables:

  $mode - the third element from stat

Variables used or routines called:

  None

How to use:

   my $md = $self->format_mode((stat $fn)[2]);

Return: string with permission bits such as -r-xr-xr-x.

=cut

sub format_mode {
    my $s = ref($_[0]) ? shift : (File::Stat::Ls->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
     ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
      $atime,$mtime,$ctime,$blksize,$blocks) = stat($fn);


Variables used or routines called:

  None

How to use:

   my $ls = $self->ls_stat($fn);

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

  -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

=cut

sub ls_stat {
    my $s = ref($_[0]) ? shift : (File::Stat::Ls->new);
    my $fn = shift; 
    my ($dev,$ino,$mode,$nlink,$uid,$gid,$rdev,$size,
        $atime,$mtime,$ctime,$blksize,$blocks) = lstat $fn;
    my @a = 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 $fmt = "%10s %3d %7s %4s %12d %12s %-26s\n";  
    return sprintf $fmt, $fm,$nlink,$ud,$gd,$size,$mt,$fn;
}

1;

=head1 HISTORY

=over 4

=item * Version 0.10

This version includes two methods: format_mode and ls_stat.

=cut

=head1 SEE ALSO (some of docs that I check often)

Data::Describe, Oracle::Loader, CGI::Getopt, File::Xcopy, 
Oracle::Trigger, Debug::EchoMessage, CGI::Getopt, etc.

=head1 AUTHOR

Copyright (c) 2005 Hanming Tu.  All rights reserved.

This package is free software and is provided "as is" without express
or implied warranty.  It may be used, redistributed and/or modified
under the terms of the Perl Artistic License (see
http://www.perl.com/perl/misc/Artistic.html)

=cut