view release on metacpan or  search on metacpan

lib/Brackup/File.pm  view on Meta::CPAN

    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;
        sysopen(my $fh, $path, O_RDONLY) or die "Failed to open $path: $!";
        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 uid {
    my $self = shift;
    return $self->stat->uid;
}

sub gid {
    my $self = shift;
    return $self->stat->gid;
}

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", printable($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);
        }
    }

    my $uid = $self->uid;
    unless ($uid eq $backup->default_uid) {
      $set->("UID", $uid);
    }
    my $gid = $self->gid;
    unless ($gid eq $backup->default_gid) {
      $set->("GID", $gid);
    }

    return $ret . "\n";
}

1;