# -*- perl -*-
#
# $Id: FileInfo.pm,v 1.7 1998/03/22 13:11:01 ejb Exp $
# $Source: /home/ejb/source/perl/modules/RCS/FileInfo.pm,v $
# $Author: ejb $
#

require 5.000;
use strict;

package FileInfo;
my $package = "FileInfo";

use Time::Local;

# Field names
my $f_mode = "mode";
my $f_size = "size";
my $f_month = "month";
my $f_day = "day";
my $f_time = "time";
my $f_year = "year";
my $f_name = "file";
my $f_type = "type";

# Static Variables
my $ty_file = "file";
my $ty_nonfile = "non-file";
my @months = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
my %months = ();
{
    my $i;
    for ($i = 0; $i < scalar(@months); $i++)
    {
	# This is purposely 0 through 11 to agree with localtime
	$months{$months[$i]} = $i;
    }	
}
my @file_templates = ();

# Match for UNIX servers' ls commands
sub p_parse_unix_ls
{
    my $file_template = shift;
    my $line = shift;
    my ($name, $size, $mode, $time, $month, $day, $year, $type);
    ($line =~ m/$file_template/) ||
	die "$package: internal error for unix file template\n";
    my $umode = $1;
    $mode = &p_parse_unix_mode($1);
    $size = $2;
    $month = $3;
    $day = $4;
    my $time_or_year = $5;
    $name = $6;
    if ($time_or_year =~ m/:/)
    {
	$time = $time_or_year;
	$year = &p_unix_ls_year($month);
    }
    else
    {
	$time = "00:00";	# don't know and don't care
	$year = $time_or_year;
    }
    $type = ($umode =~ m/^d/) ? $ty_nonfile : $ty_file;
    ($name, $size, $mode, $time, $month, $day, $year, $type);
}

{
    my $protections =
	'(?:([a-zA-Z-][r-][w-][xsS-][r-][w-][xsS-][r-][w-][xtT-])\\s)';
    my $month = join('|', @months);
    my $day = '[ 0-9][0-9]';
    my $time = '[0-9]{1,2}:[0-9]{2}';
    my $year = '[0-9]{4}';
    my $time_or_year = "(?:$time)|(?:$year)";
    my $date = "(?:($month)\\s+($day)\\s+($time_or_year))";
    my $file_template = "^(?:.*)$protections.*?([0-9]+)\\s+$date\\s*(\\S+)";
    my $function = \&p_parse_unix_ls;
    push(@file_templates, [$file_template, $function]);
}

# Match for Chameleon TCP/IP's servers' ls command (Windows for Workgroups)
sub p_parse_chameleon_ls
{
    my $file_template = shift;
    my $line = shift;
    my ($name, $size, $mode, $time, $month, $day, $year, $type);
    ($line =~ m/$file_template/) ||
	die "$package: internal error for Chameleon file template\n";
    $name = $1;
    my $size_or_dir = $2;
    $month = $3;
    $day = $4;
    $year = $5;
    $time = $6;
    $mode = &p_parse_chameleon_mode($7);
    if ($size_or_dir =~ m/DIR/)
    {
	$size = 0;
	$type = $ty_nonfile;
    }
    else
    {
	$size = $size_or_dir;
	$type = $ty_file;
    }
    ($name, $size, $mode, $time, $month, $day, $year, $type);
}

{
    my $filename = "(.{12})";
    my $size_or_dir = "((?:\<DIR\>)|[0-9]+)";
    my $month = join('|', @months);
    my $day = '[ 0-9][0-9]';
    my $year = '[0-9]{4}';
    my $time = '[0-9]{1,2}:[0-9]{2}';
    my $protections = '([d-][r-][w-].)';
    my $file_template = "^$filename\\s+$size_or_dir\\s+" .
	"($month) ($day) ($year) ($time) $protections";
    my $function = \&p_parse_chameleon_ls;
    push(@file_templates, [$file_template, $function]);
}

# Routines

sub new
{
    my $class = shift;
    my $rep = +{$package => {} };
    my $file = shift;
    my @stat;
    if (@stat = lstat($file))
    {
	my $time = $stat[9];
	my ($min, $hour, $month, $day, $year);
	(undef, $min, $hour, $day, $month, $year) = localtime($time);
	$rep->{$package}{$f_name} = $file;
	$rep->{$package}{$f_size} = $stat[7];
	$rep->{$package}{$f_mode} = sprintf("%04o", $stat[2] & 07777);
	$rep->{$package}{$f_time} = "$hour:$min";
	$rep->{$package}{$f_month} = $months[$month];
	$rep->{$package}{$f_day} = $day;
	$rep->{$package}{$f_year} = 1900 + $year;
	$rep->{$package}{$f_type} = (-f _ ? $ty_file : $ty_nonfile);
	return bless $rep, $class;
    }

    # Stat failed
    undef;
}

sub new_from_ls
{
    my $class = shift;
    my @lines = @_;
    my @result = ();
    my $line;
    foreach $line (@lines)
    {
	my $rep = +{$package => {} };
	chop $line;
	my $f;
	foreach $f (@file_templates)
	{
	    my ($file_template, $function) = @$f;
	    if ($line =~ m/$file_template/)
	    {
		my @file_info = (&$function($file_template, $line));
		($rep->{$package}{$f_name},
		 $rep->{$package}{$f_size},
		 $rep->{$package}{$f_mode},
		 $rep->{$package}{$f_time},
		 $rep->{$package}{$f_month},
		 $rep->{$package}{$f_day},
		 $rep->{$package}{$f_year},
		 $rep->{$package}{$f_type}) = @file_info;
		bless $rep, $class;
		push (@result, $rep);
	    }
	}
    }

    @result;
}

sub p_unix_ls_year
{
    my $month = shift;

    # If this month is later than our current month, then it refers to last
    # year; otherwise, it refers to this year.

    my @time = localtime;
    my ($this_month, $this_year) = @time[4, 5];
    $this_year += 1900;		# sorry, but that's how localtime returns year
    if ($months{$month} > $this_month)
    {
	$this_year - 1;
    }
    else
    {
	$this_year;
    }
}

sub p_parse_unix_mode
{
    my ($modestr) = @_;
    my $mode;
    my @fields;

    $modestr =~ s/^.//;
    @fields = split('', $modestr);

    $mode = 0;

    $mode |= 00400 if ($fields[0] eq "r");
    $mode |= 00200 if ($fields[1] eq "w");
    $mode |= 00100 if ($fields[2] eq "x");
    $mode |= 04100 if ($fields[2] eq "s");
    $mode |= 04000 if ($fields[2] eq "S");

    $mode |= 00040 if ($fields[3] eq "r");
    $mode |= 00020 if ($fields[4] eq "w");
    $mode |= 00010 if ($fields[5] eq "x");
    $mode |= 02010 if ($fields[5] eq "s");
    $mode |= 02000 if ($fields[5] eq "S");

    $mode |= 00004 if ($fields[6] eq "r");
    $mode |= 00002 if ($fields[7] eq "w");
    $mode |= 00001 if ($fields[8] eq "x");
    $mode |= 01001 if ($fields[8] eq "t");
    $mode |= 01000 if ($fields[8] eq "T");

    sprintf("%04o", $mode);
}

sub p_parse_chameleon_mode
{
    my ($modestr) = @_;
    my $mode;
    my @fields;

    $modestr =~ s/^.//;
    @fields = split('', $modestr);

    $mode = 0;

    $mode |= 00555 if ($fields[0] eq "r");
    $mode |= 00220 if ($fields[1] eq "w");

    sprintf("%04o", $mode);
}

sub unparse
{
    my $rep = shift;
    my ($mode, $size, $month, $day, $time, $year, $file, $type) =
	($rep->{$package}{$f_mode},
	 $rep->{$package}{$f_size},
	 $rep->{$package}{$f_month},
	 $rep->{$package}{$f_day},
	 $rep->{$package}{$f_time},
	 $rep->{$package}{$f_year},
	 $rep->{$package}{$f_name},
	 $rep->{$package}{$f_type});
    
    ("mode: $mode\n" . 
     "size: $size\n" .
     "month: $month\n" .
     "day: $day\n" .
     "time: $time\n" .
     "year: $year\n" .
     "file: $file\n" .
     "type: $type\n" .
     "\n");
}

sub sameas
{
    my ($lhs, $rhs) = @_;
    (($lhs->size() == $rhs->size()) &&
     ($lhs->time() eq $rhs->time()) &&
     ($lhs->day() eq $rhs->day()) &&
     ($lhs->month() eq $rhs->month()) &&
     ($lhs->year() eq $rhs->year()) &&
     ($lhs->type() eq $rhs->type()));
}

sub mode
{
    my $rep = shift;
    $rep->{$package}{$f_mode};
}

sub size
{
    my $rep = shift;
    $rep->{$package}{$f_size};
}

sub month
{
    my $rep = shift;
    $rep->{$package}{$f_month};
}

sub day
{
    my $rep = shift;
    $rep->{$package}{$f_day};
}

sub time
{
    my $rep = shift;
    $rep->{$package}{$f_time};
}

sub year
{
    my $rep = shift;
    $rep->{$package}{$f_year};
}

sub name
{
    my $rep = shift;
    $rep->{$package}{$f_name};
}

sub type
{
    my $rep = shift;
    $rep->{$package}{$f_type};
}

sub ty_file
{
    $ty_file;
}

sub ty_nonfile
{
    $ty_nonfile;
}

sub mtime
{
    my $rep = shift;
    my ($month, $day, $time, $year) =
	($rep->{$package}{$f_month},
	 $rep->{$package}{$f_day},
	 $rep->{$package}{$f_time},
	 $rep->{$package}{$f_year});
    my ($hour, $min) = (split(/:/, $time));

    # We don't really care about the timezone.  The information isn't
    # available, so it's best to assume GMT.
    # Yes, subtracting 1900 still works after 2000.
    timelocal(0, $min, $hour, $day, $months{$month}, $year - 1900);
}

sub test
{
    shift;
    my $file = shift;
    my $file_info = new FileInfo($file);
    die "undefined\n" unless defined $file_info;
    print $file_info->unparse();
    print $file_info->mtime(), "\n";
}

1;