;# ;# 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 () { 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 = ; my $y = ; 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