package Brackup::File; # "everything is a file" # ... this class includes symlinks and directories use strict; use warnings; use Carp qw(croak); use File::stat (); use Fcntl qw(S_ISREG S_ISDIR S_ISLNK); use Digest::SHA1; use Brackup::PositionedChunk; sub new { my ($class, %opts) = @_; my $self = bless {}, $class; $self->{root} = delete $opts{root}; $self->{path} = delete $opts{path}; $self->{stat} = delete $opts{stat}; # File::stat object croak("Unknown options: " . join(', ', keys %opts)) if %opts; die "No root object provided." unless $self->{root} && $self->{root}->isa("Brackup::Root"); die "No path provided." unless $self->{path}; $self->{path} =~ s!^\./!!; return $self; } sub root { my $self = shift; return $self->{root}; } # returns File::stat object sub stat { my $self = shift; return $self->{stat} if $self->{stat}; my $path = $self->fullpath; my $stat = File::stat::lstat($path); return $self->{stat} = $stat; } sub size { my $self = shift; return $self->stat->size; } sub is_dir { my $self = shift; return S_ISDIR($self->stat->mode); } sub is_link { my $self = shift; my $result = eval { S_ISLNK($self->stat->mode) }; $result = -l $self->fullpath unless defined($result); return $result; } sub is_file { my $self = shift; return S_ISREG($self->stat->mode); } sub supported_type { my $self = shift; return $self->type ne ""; } # returns "f", "l", or "d" like find's -type sub type { my $self = shift; return "f" if $self->is_file; return "d" if $self->is_dir; return "l" if $self->is_link; return ""; } sub fullpath { my $self = shift; return $self->{root}->path . "/" . $self->{path}; } # a scalar that hopefully uniquely represents a single version of a file in time. sub cachekey { my $self = shift; my $st = $self->stat; return "[" . $self->{root}->name . "]" . $self->{path} . ":" . join(",", $st->ctime, $st->mtime, $st->size, $st->ino); } # iterate over chunks sized by the root's configuration sub foreach_chunk { my ($self, $cb) = @_; foreach my $chunk ($self->chunks) { $cb->($chunk); } } sub _min { return (sort { $a <=> $b } @_)[0]; } sub chunks { my $self = shift; return @{ $self->{chunks} } if $self->{chunks}; my $root = $self->{root}; my $chunk_size = $root->chunk_size; # non-files don't have chunks my @list; if ($self->is_file) { my $offset = 0; my $size = $self->size; while ($offset < $size) { my $len = _min($chunk_size, $size - $offset); my $chunk = Brackup::PositionedChunk->new( file => $self, offset => $offset, length => $len, ); push @list, $chunk; $offset += $len; } } $self->{chunks} = \@list; return @list; } sub full_digest { my $self = shift; return $self->{_full_digest} ||= $self->_calc_full_digest; } sub _calc_full_digest { my $self = shift; return "" unless $self->is_file; my $cache = $self->{root}->digest_cache; my $key = $self->cachekey; my $dig = $cache->get($key); return $dig if $dig; # legacy migration thing... we used to more often store # the chunk digests, not the file digests. so try that # first... if ($self->chunks == 1) { my ($chunk) = $self->chunks; $dig = $cache->get($chunk->cachekey); } unless ($dig) { my $sha1 = Digest::SHA1->new; my $path = $self->fullpath; open (my $fh, $path) or die "Couldn't open $path: $!\n"; binmode($fh); $sha1->addfile($fh); close($fh); $dig = "sha1:" . $sha1->hexdigest; } $cache->set($key => $dig); return $dig; } sub link_target { my $self = shift; return $self->{linktarget} if $self->{linktarget}; return undef unless $self->is_link; return $self->{linktarget} = readlink($self->fullpath); } sub path { my $self = shift; return $self->{path}; } sub as_string { my $self = shift; my $type = $self->type; return "[" . $self->{root}->as_string . "] t=$type $self->{path}"; } sub mode { my $self = shift; return sprintf('%#o', $self->stat->mode & 0777); } sub as_rfc822 { my ($self, $schunk_list, $backup) = @_; my $ret = ""; my $set = sub { my ($key, $val) = @_; return unless length $val; $ret .= "$key: $val\n"; }; my $st = $self->stat; $set->("Path", $self->{path}); my $type = $self->type; if ($self->is_file) { my $size = $self->size; $set->("Size", $size); $set->("Digest", $self->full_digest) if $size; } else { $set->("Type", $type); if ($self->is_link) { $set->("Link", $self->link_target); } } $set->("Chunks", join("\n ", map { $_->to_meta } @$schunk_list)); unless ($self->is_link) { $set->("Mtime", $st->mtime); $set->("Atime", $st->atime) unless $self->root->noatime; my $mode = $self->mode; unless (($type eq "d" && $mode eq $backup->default_directory_mode) || ($type eq "f" && $mode eq $backup->default_file_mode)) { $set->("Mode", $mode); } } return $ret . "\n"; } 1;