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;


syntax highlighted by Code2HTML, v. 0.9.1