;#
;# Copyright (c) 1995-1997
;# 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: DIR.pm,v 1.12 1997/09/09 22:04:58 ikuo Exp $
;#
package Fan::DIR;
use strict;
use vars qw($VERSION $LOG %required %typemap %typerev);
use Fan::Attrib;
use Fan::Cool;
use AutoLoader 'AUTOLOAD';
$VERSION = '0.01';
$LOG = 5;
;#
@typemap{qw(directory symlink file)} = qw(D L F);
@typerev{qw(D L F)} = qw(directory symlink file);
@required{qw(D L F)} = (
[ qw(mode owner group begin-update end-update) ],
[ qw(mode owner group linkto) ],
[ qw(mode owner group modified size md5checksum) ] );
;# A special marker for AutoSplit.
1;
__END__
;#
;# create a DIR object.
;# $dir = DIR->new(directory => "/ftp/pub/utils");
;#
sub new ($%) {
my $this = shift;
my $class = ref($this) || $this;
my %params = @_;
my $self = \%params;
bless $self, $class;
carp("DIR CREATING $self") if $LOG > 5;
$self->{dir_hash} = {}; # empty hash
$self->{dir_array} = []; # empty array
$self;
}
;#
sub DESTROY ($) {
my $self = shift;
my $name;
for $name (keys %{$self->{entires}}) {
delete($self->{dir_hash}->{$name}); # delete Attribs
}
carp("DIR DESTROYING $self") if $LOG > 5;
}
;#
sub get ($$) {
my $self = shift;
my $name = shift;
exists($self->{dir_hash}->{$name}) &&
ref($self->{dir_hash}->{$name}) eq 'Fan::Attrib' ?
$self->{dir_hash}->{$name} : undef;
}
;#
sub add ($$) {
my $self = shift;
my $y = shift;
$self->{dir_hash}->{$y->name} = $y if ref($y) eq 'Fan::Attrib';
$y;
}
;#
sub delete ($$) {
my $self = shift;
my $name = shift;
delete($self->{dir_hash}->{$name});
}
;#
sub index ($) {
my $self = shift;
@{$self->{dir_array}};
}
;#
;# Load entries from a file, and fill %{$self->{dir_hash}}.
;# $dir = DIR->new(dir_path => $directory);
;# $dir->load;
;#
;# You can specify a filename rather than a directory name.
;# $dir->load("$temp/tmp_dirinfo");
;#
sub load ($$) {
my $self = shift;
my $dir = @_ ? shift : $self->{dir_path};
my $dirinfo = -d $dir ? "$dir/.dirinfo" : $dir;
my %assoc = ();
local(*FILE, $_);
# get directory info if exists
-f $dirinfo or warn("$dirinfo is not a plain file."), return undef;
open(FILE, $dirinfo) or warn("open($dirinfo): $!"), return undef;
#
my $pp = undef;
while (<FILE>) {
s/^\s+//; s/\s+$//; next if /^$/ || /^#/;
/\s*=\s*/ || next;
my($key, $val) = ($`, $');
if (defined($typemap{$key})) {
$pp = \%{$assoc{$val}};
$pp->{y_type} = $typemap{$key};
$pp->{y_name} = $val;
} elsif ($key eq 'modified') {
$pp->{y_mtime} = $val;
} elsif ($key eq 'mode') {
$pp->{y_perm} = oct($val);
} elsif ($key eq 'owner') {
my $u = getpwnam($val) if $val !~ /^\d+$/;
$val = $u if $u ne '';
$pp->{y_owner} = $val;
} elsif ($key eq 'group') {
my $g = getgrnam($val) if $val !~ /^\d+$/;
$val = $g if $g ne '';
$pp->{y_group} = $val;
} elsif ($key eq 'md5checksum') {
$pp->{y_checksum} = $val if $val =~ /^[a-f0-9]{32}$/;
} else { # others...
$key =~ tr/-/_/;
$pp->{"y_$key"} = $val;
}
}
close(FILE);
# DO NOT clear hash, but clean array
# $self->{dir_hash} = {};
$self->{dir_array} = [];
# register all entires..
my $name;
for $name (sort keys %assoc) {
next if $name eq '' || $name eq '.' || $name eq '..';
next if $name /\//;
my $y = Fan::Attrib->new(%{$assoc{$name}});
if (defined($y) && ref($y) eq 'Fan::Attrib') {
$self->add($y);
# warn("load: $name... added\n") if $LOG > 7;
push(@{$self->{dir_array}}, $name);
} else {
warn("Can't create Fan::Attrib object.");
}
}
# success value
1;
}
;#
;# fill directory information to $self->{dir_hash}.
;# make_dirinfo sets values of begin-update / end-update for directories
;# if and only if old dirinfo contains them.
;# Other values are re-generated by make_dirinfo.
;#
sub fill ($$) {
my $self = shift;
my $dir = shift;
# Calculating MD5 checksum is very slow...
# We can choose calculate it or not.
my $no_md5 = $self->{ignore_md5checksum};
local(*DIR, $[, $_);
# check directory
$dir ne '' && -d $dir
or warn("dir is not a directory"), return undef;
# get directory entries
opendir(DIR, $dir)
or carp("opendir($dir): $!"), return undef;
my @list = sort readdir(DIR);
closedir(DIR);
# DO NOT clear my entries...
# $self->{dir_hash} = {};
$self->{dir_array} = [];
# checking all entries
my $file;
for $file (@list) {
next if $file eq '' || $file eq '.' || $file eq '..';
next if $file =~ /^\.dirinfo/;
next if $file =~ /\//;
my $z = $self->get($file);
my $y = Fan::Attrib->new(attr_path => "$dir/$file");
unless (defined($y) && ref($y) eq 'Fan::Attrib') {
warn("Can't create attrib object."), next;
}
$y->fill_checksum;
if ($z) {
$z->copyfrom($y); # in overwrite mode.
} else {
$self->add($y);
}
# warn("fill: $file... added\n") if $LOG > 7;
push(@{$self->{dir_array}}, $file); # register file name
} # end of for $file (@list) { ... }
#
1;
}
;# Write directory information(in %{$self->{dir_hash}})
;# to the file.
;# $dir = DIR->new($directory);
;# $dir->fill;
;# $dir->store;
;#
;# This routine will return zero if nothing has been modified,
;# or non-zero value will be returned.
sub store ($;$) {
my $self = shift;
my $dir = @_ ? shift : $self->{dir_path};
my $dirinfo = -d $dir ? "$dir/.dirinfo" : $dir;
my $temp = "$dirinfo.$$";
local(*FILE, *TEMP, $_);
# next, we open the file with write mode
open(TEMP, ">$temp")
or carp("open($temp): $!"), return undef;
# current directory information
my $y;
if (defined($y = $self->get('.'))) {
&putdata($y, \*TEMP);
}
#
my $name;
for $name (@{$self->{dir_array}}) {
$y = $self->get($name);
# check filename
# we hate illegal filenames, but '.' is a special filename
# which contains current directory information.
# shall we store information for '.' first?
next if $name eq '' || $name eq '.' || $name eq '..';
next if $name =~ /^\.dirinfo/;
next if $name =~ /\//;
# warn("store: ".$y->name."...\n") if $LOG > 7;
&putdata($y, \*TEMP);
}
# close temporary info file once.
close(TEMP);
# comapre old and new files.
if (open(FILE, $dirinfo) && open(TEMP, $temp)) {
my $comp = 0;
my $cont = 1;
while ($cont) {
$cont = 0;
my $x = <FILE>;
my $y = <TEMP>;
if (defined($x) && defined($y)) {
$x =~ s/\s+$//;
$y =~ s/\s+$//;
$cont++ if !($comp = $x cmp $y);
} else {
$comp = defined($x) || defined($y);
}
}
close(FILE); close(TEMP);
if (!$comp) {
warn("$dir: no change\n") if $LOG > 6;
unlink($temp), return 0; ## NO CHANGE
}
}
# Now, we try to rename from temporary file to the real one.
if (!rename($temp, $dirinfo)) {
unlink($temp);
warn("rename($temp, $dirinfo): $!\n") if $LOG > 4;
return undef;
}
# We have changed!
warn("store: $dir was updated") if $LOG > 6;
return 1; # CHANGED
}
;#
;# update dirinfo recursively
;# update_dirinfo returns 1 iff any change was found.
;#
sub update {
my $self = shift;
my $dir = @_ ? shift : $self->{dir_path};
local(*DIR, $[, $_);
my($old, $new, @stat, @list);
my $dirinfo = "$dir/.dirinfo";
# check directory
$dir ne '' && -d $dir
or warn("dir is not a directory"), return undef;
# generate entires.
$self->load($dir); # load old values...
$self->fill($dir); # and merge new values.
# entries...
my $file;
for $file (@{$self->{dir_array}}) {
next if $file eq '' || $file eq '.' || $file eq '..';
next if $file =~ /^\.dirinfo/;
next if $file =~ /\//; # must not contain '/'
my $y = $self->get($file);
next if $y->type ne 'D';
my $t = time; # current time.
my $kid = $self->new;
if ($kid->update("$dir/$file") ||
!defined($y->{y_begin_update}) ||
!defined($y->{y_end_update})) {
$y->{y_begin_update} = $t;
$y->{y_end_update} = time;
}
} # end of for $file (@list) { ... }
# return value is that of store.
$self->store($dir);
}
;#
sub putdata {
my $y = shift; # is Fan::Attrib object.
my $out = shift; # must be a file handle.
printf $out "%s = %s\n", $typerev{$y->type}, $y->name;
my $key;
for $key (@{$required{$y->type}}) {
my $tmp = $key;
$tmp =~ tr/-/_/;
$tmp = "checksum" if $key eq 'md5checksum';
$tmp = "y_$tmp";
if ($key eq 'mode') {
printf $out " $key = %04o\n", $y->{y_perm};
} elsif ($key eq 'modified') {
printf $out " $key = %d\n", $y->{y_mtime};
} else {
printf $out " %s = %s\n", $key, $y->{$tmp};
}
}
}
;# end of Fan::DIR module
syntax highlighted by Code2HTML, v. 0.9.1