;#
;# Copyright (c) 1995-1998
;#	Ikuo Nakagawa. All rights reserved.
;#
;# Redistribution and use in source and binary forms, with or without
;# modification, are permitted provided that the following conditions
;# are met:
;#
;# 1. Redistributions of source code must retain the above copyright
;#    notice unmodified, this list of conditions, and the following
;#    disclaimer.
;# 2. Redistributions in binary form must reproduce the above copyright
;#    notice, this list of conditions and the following disclaimer in the
;#    documentation and/or other materials provided with the distribution.
;#
;# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND
;# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
;# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
;# PURPOSE ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS
;# BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY,
;# OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT
;# OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
;# BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;# WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
;# OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
;# EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;#
;# $Id: Attrib.pm,v 1.24 1999/10/28 10:32:18 ikuo Exp $
;#
package Fan::Attrib;

use strict;
use vars qw($VERSION $LOG
	$tzoff @nameofmonth %nametomonth @accept %escape
	$regexp_month $regexp_t %y_keys
	$n_obj $max_obj $seq_obj);

;# modules...
use POSIX qw(time_h);
use Carp;
use AutoLoader 'AUTOLOAD';

;# this is alpha version...
$VERSION = '0.02';

;# initialize counters.
BEGIN {
	$LOG = 5;
	$n_obj = $max_obj = $seq_obj = 0;
}

;# show counters if requried.
END {
	if ($LOG > 5) {
		warn("Attrib status summary report:\n");
		warn(" total $seq_obj object created\n");
		warn(" maximum # of objects are $max_obj\n");
		warn(" remaining objects are $n_obj\n");
	}
}

;# offset time of local timezone.
$tzoff = 86400 - mktime(gmtime(86400));

;# name of month, and conversion table
@nameofmonth = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
@nametomonth{map(lc $_, @nameofmonth)} = (0..11);
$regexp_month = join('|', @nameofmonth);
$regexp_t = '(\d+:\d+:\d+\s+\d\d\d\d)|(\d\d\d\d)|(\d+:\d+)';

;# Encode / decode path names
;# We must encode, at least, EQUAL, spaces and non printable charactors.
;# Off course, '%' itself must also be encoded.
@accept = ('*', '+', '-', '.', ',', '@', '_',
	'0'..'9', 'A'..'Z', 'a'..'z', '/', '~');
@escape{@accept} = @accept;

;# initialize @escape
for (my $i = 0; $i < 256; $i++) {
	my $c = pack("C", $i);
	$escape{$c} = sprintf("%%%02x", $i) if !defined($escape{$c});
}

;# keys we should treat.
%y_keys = (
	y_flag		=> 0x01,
	y_type		=> 0x02,
	y_name		=> 0x01,
	y_path		=> 0x01,
	y_realpath	=> 0x01,
	y_perm		=> 0x01,
	y_owner		=> 0x01,
	y_group		=> 0x01,
	y_size		=> 0x01,
	y_mtime		=> 0x09,
	y_time0		=> 0x01,
	y_date		=> 0x01,
	y_checksum	=> 0x01,
	y_linkto	=> 0x01,
);

;# generate basic sub routines
;# from y_keys...
for my $key (keys %y_keys) {
	next if 0x08 & $y_keys{$key};
	my $f = $key;
	$f =~ s/^y_//;
	my $sub = <<"END";
sub $f (\$;\$) { my \$y = shift; \$y->{$key} = shift if \@_; \$y->{$key} }
END
	eval $sub;
	die $@ if $@;
}

;#
sub debug ($@) {
	local $_;
	grep((print STDERR $_), @_) if $LOG >= shift;
}

;# A special marker for AutoSplit.
1;
__END__

;# destroy a Attrib object.
sub DESTROY ($) {
	my $y = shift;

	# count down # of objects.
	$n_obj--;

	# debug log...
	if ($LOG > 5) {
		my $t = $y->type;
		$t .= ' '.$y->name if $t ne '.' && $t ne 'U';
		carp("Attrib DESTROYING $y ($t)") if $LOG > 5;
	}
}

;#
;# creat a Attrib new object.
;#	attr_path => /where/file/exists	or
;#	attr_line => attribute line	or
;#	attr_list => hogehoge		or
;#	dictionary...
;#
;#	attr_keys => reference to a hash $p.
;#		by default, \%y_keys is used.
;#
;# An Attrib object has some of following values.
;#	y_type
;#	y_name
;#	y_path
;#	y_realpath
;#	y_perm
;#	y_owner
;#	y_group
;#	y_size
;#	y_time0
;#	y_date
;#	y_checksum
;#	y_linkto
;#
sub new ($%) {
	my $this = shift;
	my $class = ref($this) || $this;
	my %params = @_;

	# Bless myself.
	my $y = bless {}, $class;
	ref($y) or return undef;

	# Count up # of objects.
	$seq_obj++;
	$n_obj++;
	$max_obj = $n_obj if $max_obj < $n_obj;

	# Select initializer
	if (defined($params{attr_path})) {	# from a real file
		$y->from_path($params{attr_path}) or return undef;
	} elsif (defined($params{attr_line})) {	# from a line
		$y->from_line($params{attr_line}) or return undef;
	} elsif (defined($params{attr_list})) {	# from ls format
		$y->from_list($params{attr_list}) or return undef;
	} else {				# from %params
		for my $tag (keys %params) {
			$y->{$tag} = $params{$tag} if $tag =~ /^y_/;
		}
	}

	# Can we trust this?
	$y && $y->validate or return undef;

	# For debugging purpose
	if ($LOG > 5) {
		my $t = $y->type;
		$t .= ' '.$y->name if $t ne '.' && $t ne 'U';
		carp("Attrib CREATING $y ($t)");
	}

	# Return this object.
	$y;
}

;# encoder
sub attr_encode ($) {
	local $_ = shift; s/./$escape{$&}/g; $_;
}

;# decoder
sub attr_decode ($) {
	local $_ = shift; s/\%(..)/pack("H*", $1)/eg; $_;
}

;# get mtime / change mtime (and also change modified time).
sub mtime ($;$) {
	my $y = shift;

	if (@_) {
		$y->{y_mtime} = &get_mtime(shift);
	}
	$y->{y_mtime};
}

;# convert mtime string to GMT time value.
sub get_mtime ($) {
	local $_ = shift;

	/^(\d\d\d\d)(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)$/
		&& return mktime($6, $5, $4, $3, $2 - 1, $1 - 1900) + $tzoff;
	/^\d+$/ && return $_;

	warn("get_mtime: wrong format") if $LOG > 5;
	return undef;
}

;# convert GMT time value to MDTM format
sub gmt2mdtm ($) {
	local $_ = shift;

	defined($_) && /^\d+$/ or return undef;
	my @t = reverse((gmtime($_))[0..5]);
	$t[0] += 1900;
	$t[1]++;
	sprintf("%04d%02d%02d%02d%02d%02d", @t);
}

;# clean up any y_* entries
sub cleanup ($) {
	my $y = shift;

	for my $t (keys %{$y}) {
		delete($y->{$t}) if $t =~ /^y_/;
	}
	$y;
}

;#
;# Validate an Attrib object.
;# If any unexpected case occurs, validate returns undef.
;#
sub validate ($) {
	my $y = shift;
	my $t = $y->{y_type}; # for type abbrev.

	# debug log
	debug(8, "* validate $y\n");

	# check type first.
	if (!defined($t)) { # type must be defined.
		confess("$y has no type, panic...");
	} elsif ($t !~ /^[.DFLU]$/) { # normal types
		carp("$y has wrong type: $t");
		return undef;
	} else {
		debug(8, " check ok: type = $t\n");
	}

	# terminator is always success.
	return 1 if $t eq '.';

	# check relative pathname if exists.
	if (!defined($y->{y_path})) { # anything is ok
		debug(8, " check ok: no path\n");
	} else {
		debug(8, " check ok: path = $y->{y_path}\n");
	}

	# check real pathname if exists.
	if (!defined($y->{y_realpath})) { # anything is ok
		debug(8, " check ok: no realpath\n");
	} else {
		debug(8, " check ok: realpath = $y->{y_realpath}\n");
	}

	# check of the type UP stair.
	if (!defined($y->{y_name})) {
		if ($t eq 'U') {
			debug(8, " check ok: no name (type U)\n");
		} else {
			carp("$y has no name");
			return undef;
		}
	} else {
		my $n = $y->{y_name};

		# invalid name causes security problems...
		if ($n ne '' && $n ne '..' && $n !~ /\//) {
			debug(8, " check ok: name = $n\n");
		} else {
			carp("$y has wrong name: $n");
			return undef;
		}
	}

	# check flags if exists
	if (!defined($y->{y_flag})) {
		debug(8, " check ok: no flag\n");
	} elsif ($y->{y_flag} =~ /^[-+=!]?$/) {
		debug(8, " check ok: flag = $y->{y_flag}\n");
	} else {
		carp("$y has wrong flag: $y->{y_flag}");
		return undef;
	}

	# check size if exists
	if (!defined($y->{y_size})) {
		debug(8, " check ok: no size\n");
	} elsif ($y->{y_size} =~ /^\d+$/) {
		debug(8, " check ok: size = $y->{y_size}\n");
	} else {
		carp("$y has wrong size: $y->{y_size}");
		return undef;
	}

	# check checksum values
	if (!defined($y->{y_checksum})) {
		debug(8, " check ok: no checksum\n");
	} elsif ($y->{y_checksum} =~ /^[a-f0-9]{32}$/) {
		debug(8, " check ok: checksum = $y->{y_checksum}\n");
	} else {
		carp("$y has wrong checksum: $y->{y_checksum}");
		return undef;
	}

	# check linkto
	if (!defined($y->{y_linkto}) && $t eq 'L') {
		carp("$y has no linkto (type L)");
		return undef;
	} elsif (!defined($y->{y_linkto})) {
		debug(8, " check ok: no linkto\n");
	} else {
		debug(8, " check ok: linkto = $y->{y_linkto}\n");
	}

	# check permission if exists
	if (!defined($y->{y_perm})) {
		debug(8, " check ok: no perm\n");
	} elsif ($y->{y_perm} =~ /^\d+$/) {
		debug(8, " check ok: perm = $y->{y_perm}\n");
	} else {
		carp("$y has wrong perm: $y->{y_perm}");
		return undef;
	}

	# check owner
	if (!defined($y->{y_owner})) {
		debug(8, " check ok: no owner\n");
	} elsif ($y->{y_owner} =~ /^[-_\w]+$/) {
		debug(8, " check ok: owner = $y->{y_owner}\n");
	} else {
		carp("$y has wrong owner: $y->{y_owner}");
		return undef;
	}

	# check group
	if (!defined($y->{y_group})) {
		debug(8, " check ok: no group\n");
	} elsif ($y->{y_group} =~ /^[-_\w]+$/) {
		debug(8, " check ok: group = $y->{y_group}\n");
	} else {
		carp("$y has wrong group: $y->{y_group}");
		return undef;
	}

	# check modification time
	if (defined($y->{y_mtime})) {
		if ($y->{y_mtime} =~ /^\d+$/) {
			debug(8, " check ok: mtime = $y->{y_mtime}\n");
		} else {
			carp("$y has wrong mtime: $y->{y_mtime}");
			return undef;
		}
	} elsif (defined($y->{y_time0})) {
		if ($y->{y_time0} =~ /^\d+$/) {
			debug(8, " check ok: time0 = $y->{y_time0}\n");
		} else {
			carp("$y has wrong time0: $y->{y_time0}");
			return undef;
		}
	} else { # no time information
		debug(8, " check ok: no time information\n");
	}

	# one more debug log
	debug(8, " validation ok.\n");

	# validation o.k.
	1;
}

;#
;# Compare($x, $y) compares two references for y-structure.
;# This routine returns
;#	-1 if $x < $y
;#	 1 if $x > $y;
;#	 0 otherwise ($x == $y).
;# Both of $x and $y must have y_path parameter.
;#
sub compare ($$) {
	my $x = shift; 
	my $y = shift;

	# DEBUG purpose only.
	confess("x=$x must be an Fan::Attrib")
		unless ref($x) && $x->isa('Fan::Attrib');
	confess("y=$y must be an Fan::Attrib")
		unless ref($y) && $y->isa('Fan::Attrib');

	# $z->{y_type} eq '.' means "$z is very large".
	return  0 if $x->{y_type} eq '.' && $y->{y_type} eq '.';
	return -1 if $y->{y_type} eq '.';	# == ($x < $y)
	return  1 if $x->{y_type} eq '.';	# == ($x > $y)

	# Temporary pathnames are required to use `cmp' operator.
	my $z;
	for $z ($x, $y) {
		if (!defined($z->{y_temp})) {
			# DEBUG purpose only.
			confess("$z has no path") if !defined($z->{y_path});
			$z->{y_temp} = $z->{y_path};
			$z->{y_temp} =~ y|/|\001|;
			$z->{y_temp} .= "\001\377" if $z->{y_type} eq 'U';
		}
	}

	# Now, we can compare with `cmp'.
	return $x->{y_temp} cmp $y->{y_temp};
}

;#
;# Copy y-structure values from $b to $a.
;#
sub copyfrom ($$;$) {
	my $a = shift;
	my $b = shift;
	my $override = @_ ? shift : 0;

	for my $i (keys %{$b}) {
		if ($i =~ /^y_/ && ($override || !exists($a->{$i}))) {
			$a->{$i} = $b->{$i}
		}
	}
	$a;
}

;#
;#
sub duplicate ($) {
	my $a = shift;
	$a->new(%{$a});
}

;#
sub to_line ($) {
	my $y = shift;
	my $f = $y->{y_flag};
	my $t = $y->{y_type};
	my $b = '';	# for buffer
	my $x;		# for any

	return $f.$t if $t eq 'U' || $t eq '.';

	if (defined($x = $y->{y_perm})) {
		$b .= sprintf(" p=%04o", $x);
	}
	if (defined($x = $y->{y_owner})) {
		$b .= " o=$x";
		$b .= ".".$x if defined($x = $y->{y_group});
	}
	if (defined($x = $y->{y_mtime})) {
		$b .= " m=$x";
	}
	if ($t eq 'L' && defined($x = $y->{y_linkto})) {
		$b .= " l=".attr_encode($x);
	}
	if ($t eq 'F') {
		$b .= " s=$x" if defined($x = $y->{y_size});
		if ($x > 0) {
			$b .= " c=$y->{y_checksum}"
				if defined($x = $y->{y_checksum});
		}
	}
	$f.$t.$b." ".attr_encode($y->{y_name});
}

;#
;#
sub fill_checksum ($) {
	my $y = shift; # Attrib

	if ($y->{y_type} eq 'F' && -f $y->{y_realpath}) {
		use Fan::MD5;
		$y->{y_checksum} = MD5File($y->{y_realpath});
	}
	1;
}

;#
;#
sub fill ($;$) {
	my $y = shift;					# hash reference
	my $realpath = @_ ? shift : $y->{y_realpath};	# real pathname

	# no need to fill out
	if ($y->{y_type} eq '.' || $y->{y_type} eq 'U') {
		return $y; # good. return myself.
	}

	# get file status...
	my @s;
	if ((@s = lstat($realpath)) == 0) {
		warn("lstat($realpath): $!\n") if $LOG > 5;
		return undef;
	} elsif (-l _) {
		$y->{y_type} = 'L';
		$y->{y_linkto} = readlink($realpath);
	} elsif (-d _) {
		$y->{y_type} = 'D';
	} elsif (-f _) {
		my $change = 0;
		$change++ if $y->{y_size} != $s[7];
		$change++ if $y->{y_mtime} != $s[9];

		$y->{y_type} = 'F';
		$y->{y_size} = $s[7];
		$y->{y_mtime} = $s[9];
# MD5 checksum is very expensive.
# Do not calculate checksum in this version.
#		if ($change || $y->{y_checksum} !~ /^[a-f0-9]{32}$/) {
#			$y->fill_checksum;
#		}
	} else { # unkown types...
		return undef;
	}

	# fill out...
	$y->{y_perm} = $s[2] & 0777;
	$y->{y_owner} = $s[4];
	$y->{y_group} = $s[5];

	# get basename of the path
	$realpath =~ m%([^/]+)$%;
	$y->{y_name} = $1;
	$y->{y_realpath} = $realpath;

	# and result is hash ref.
	$y;
}

;#
;#
sub from_path ($$) {
	my $y = shift;
	my $realpath = shift; # $realpath must be exists...
	# my $flag = @_ ? shift : 0;

	$y->cleanup; # force to fill up
	$y->fill($realpath);
}

;#
;#
sub from_line ($$) {
	my $y = shift;
	my $str = shift;

	$y->cleanup;
	$y->{y_flag} = $1 if $str =~ s/^(-|\+|=)//o;
	$str =~ s/^(\S)\s*//o
		or carp("$y: can't detect file type"), return undef;
	$y->{y_type} = $1;
	my @x = split(/\s+/, $str);
	while (@x && $x[$[] =~ s/^(.)=//) {
		my($z, $val) = ($1, $');
		shift(@x);
		if ($z eq 'p') {
			$y->{y_perm} = oct($val);
		} elsif ($z eq 'o') {
			($y->{y_owner}, $y->{y_group}) =
				$val =~ /\./ ? ($`, $') : ($val, undef);
		} elsif ($z eq 'm') {
			$y->{y_mtime} = &get_mtime($val);
		} elsif ($z eq 's') {
			$y->{y_size} = $val;
		} elsif ($z eq 'c') {
			$y->{y_checksum} = $val;
		} elsif ($z eq 'l') {
			$y->{y_linkto} = attr_decode($val);
		} else {
			warn("$y: unknown attribute `$z', ignored.\n");
		}
	}

	if (@x == 0) {
		; # no filename is given
	} elsif (@x == 1) {
		$y->{y_name} = attr_decode(shift(@x));
	} else {
		carp("$y: illegal line: $str"), return undef;
	}
	$y;
}

;#
;# parsing a line from outputs of `ls', and return a reference
;#
sub from_list ($$) {
	my $y = shift;
	local $_ = shift;
	local($[); # for zero based array

	# cleanup first.
	$y->cleanup;

	# make backup of input line.
	my $x = $_;

	# DOS dirstyle - DOS like timestamp
	if (/^\d\d-\d\d-\d\d\s+\d\d:\d\d(am|pm)?/i) { # DOS
		my $date = $&;
		$_ = $';
		if (s/\s+\<DIR\>\s+//) {
			$y->{y_type}	= 'D';
			$y->{y_name}	= $_;
			return $y;
		}
		if (s/\s+(\d+)\s+//) {
			$y->{y_type}	= 'F';
			$y->{y_size}	= $1;
			$y->{y_date}	= $date;
			$y->{y_time0}	= &parsetime($date);
			$y->{y_name}	= $_;
			return $y;
		}
		debug(6, "unknown DOS format: \"$x\"\n"), return undef;
	}

	# UNIX style - cut file modes first, thanks to Shigechika AIKAWA.
	s/^ ?(.)([-r][-w].[-r][-w].[-r][-w].)\s*//
		or debug(7, "invalid format: \"$x\"\n"), return undef;

	# save filetype and mode string.
	my $type = $1;
	my $tmp = $2;

	# convert mode string to octal value
	my $mode = 0;
	$mode |= 04000 if $tmp =~ /^..[sS]/;
	$mode |= 02000 if $tmp =~ /^.....[sS]/;
	$mode |= 01000 if $tmp =~ /^........[tT]/;
	$mode |= 00400 if $tmp =~ /^r/;
	$mode |= 00200 if $tmp =~ /^.w/;
	$mode |= 00100 if $tmp =~ /^..[xs]/;
	$mode |= 00040 if $tmp =~ /^...r/;
	$mode |= 00020 if $tmp =~ /^....w/;
	$mode |= 00010 if $tmp =~ /^.....[xs]/;
	$mode |= 00004 if $tmp =~ /^......r/;
	$mode |= 00002 if $tmp =~ /^.......w/;
	$mode |= 00001 if $tmp =~ /^........[xs]/;
	$mode &= 0777; # for security reason, mask is required.

	# find date string, and save some values
	# $regexp_month = 'Jun|Feb|...|Dec'
	# $regexp_t = '(\d+:\d+:\d+\s+\d\d\d\d)|(\d\d\d\d)|(\d+:\d+)';
	/($regexp_month)\s+(\d?\d)\s+($regexp_t)/i
		or debug(7, "date not found: \"$x\"\n"), return undef;
	my($zz, $date, $file) = ($`, $&, $');

	# get size
	$zz =~ s/\s*(\d+)\s*$//
		or debug(7, "size not found: \"$x\"\n"), return undef;
	my $size = $1;

	# get link count
	$zz =~ s/^(\d+)\s*//
		or debug(7, "nlink not found: \"$x\"\n"), return undef;
	my $nlink = $1;

	# and get owner (and group)
	my($uid, $gid) = $zz =~ /\s+/ ? ($`, $') : ($zz, undef);

	# set filename to $_
	$_ = $file;

	# kill leading/trailing spaces, and trailing slash
	s/^\s+//; s/\s+$//; s/\/$//;

	# logging
	if ($LOG > 7) {
		debug(8, "parsing [$x]\n");
		debug(8, " ... filename = $_\n");
		debug(8, " ... type = $type\n");
		debug(8, " ... mode = ".sprintf("%04o", $mode)."\n");
		debug(8, " ... owner = $uid\n");
		debug(8, " ... group = $gid\n") if defined($gid);
		debug(8, " ... size = $size\n");
		debug(8, " ... date = $date\n");
		my @a = reverse((gmtime(&parsetime($date)))[0..5]);
		$a[0] += 1900;
		$a[1]++;
		debug(8, " ... time = ".
			sprintf("%04d-%02d-%02d %02d:%02d:%02d\n", @a));
	}

	# set common parameter
	$y->{y_perm}	= $mode;
	$y->{y_owner}	= $uid;
	$y->{y_group}	= $gid if defined($gid);

	# check file types.
	if ($type eq 'd') {
		debug(8, "parse: directory $_\n");
		$y->{y_type}	= 'D';
	} elsif ($type eq 'l') {
		my $linkto;
		($_, $linkto) =/\s+->\s+/ ? ($`, $') : ($_, '');
		debug(8, "parse: symlink $_ -> $linkto\n");
		$y->{y_type}	= 'L';
		$y->{y_linkto}	= $linkto;
	} elsif ($type eq '-') {
		debug(8, "parse: file $_\n");
		$y->{y_type}	= 'F';
		$y->{y_size}	= $size;
		$y->{y_date}	= $date;
		$y->{y_time0}	= &parsetime($date);
	} else {
		debug(7, "parse: unknown filetype [$type] for $_\n");
		return undef;
	}

	# ignore files who have invalid name
	if ($_ eq '' || $_ eq '.' || $_ eq '..') {
		warn("$_: invalid file name.\n") if $LOG > 6;
		return undef;
	}

	# store filename
	$y->{y_name}	= $_;

	# return this attribute object.
	$y;
}

;# parse date strings and convert to time_t
sub parsetime ($) {
	local $_ = shift;

	my($sec, $min, $hour, $day, $mon, $year) =
	/^($regexp_month)\s+(\d+)\s+((\d\d\d\d)|((\d+):(\d+)))$/oi ?
		(0, $7, $6, $2, $1, $4) : # Unix ls
	/^($regexp_month)\s+(\d+)\s+(\d+):(\d+):(\d+)\s+(\d\d\d\d)$/oi ?
		($5, $4, $3, $2, $1, $6) : # Unix ls -T
	/^(\d+)\s+($regexp_month)\s+((\d\d\d\d)|((\d+):(\d+)))$/oi ?
		(0, $7, $6, $1, $2, $4) : # dls and NetWare
	/(\d+)-(\d+)-(\d+)\s+(\d+):(\d+)(AM|PM)?/oi ?
		(0, $5, ($6 eq 'PM' ? $4 + 12 : $4) , $2, $1, $3) :
	/(\d+)-(\S+)-(\d+)\s+(\d+):(\d+)/oi ?
		(0, $5, $4, $1, $2, $3) : # VMS style
	/^\w+\s+($regexp_month)\s+(\d+)\s+(\d+):(\d+):(\d+)\s+(\d+)/oi ?
		($5, $4, $3, $2, $1, $6) : # CTAN style (and HTTP)
	/^\w+,\s+(\d+)-($regexp_month)-(\d+)\s+(\d+):(\d+):(\d+)/oi ?
		($6, $5, $4, $1, $2, $3) : # another HTTP
	(); # undef...

	# convert month to index. 
	my $month = ($mon =~ /^\d+$/ ? $& - 1 : $nametomonth{lc $mon});

	# if year is not defined, use THIS year.
	if (!defined($year) || $year !~ /\d\d\d\d/) {
		my($l_month, $l_year) = (gmtime)[4, 5];
		$year = $l_year;
		$year-- if $month > $l_month;
	} elsif ($year < 1970) {
		# if timestamp is too old, something wrong will happen.
		return 0 if $year < 1970;
	}

	# is this system dependant?
	$year -= 1900 if $year >= 1970;

	# check illegal sec/min/hour values.
	$sec = 0 unless defined($sec) && $sec >= 0 && $sec < 60;
	$min = 0 unless defined($min) && $min >= 0 && $min < 60;
	$hour = 0 unless defined($hour) && $hour >= 0 && $hour < 24;

	# return time value in GMT.
	return mktime($sec, $min, $hour, $day, $month, $year) + $tzoff;
}

;# end of Fan::Attrib module
