The Perl and Raku Conference 2025: Greenville, South Carolina - June 27-29 Learn more

NOVOZHILV / App-SimpleBackuper-0.2.26 / lib / App / SimpleBackuper / DB / FilesTable.pm 

            

              
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126

              
package App::SimpleBackuper::DB::FilesTable;
use strict;
use warnings;
use parent qw(App::SimpleBackuper::DB::BaseTable);
use Try::Tiny;
use Data::Dumper;
use App::SimpleBackuper::DB::PartsTable;
sub _pack_version {
        my($version) = @_;
         
        my $p = __PACKAGE__->packer()
                ->pack(J => 1     => $version->{backup_id_min})
                ->pack(J => 1     => $version->{backup_id_max})
                ->pack(J => 1     => $version->{uid})
                ->pack(J => 1     => $version->{gid})
                ->pack(J => 1     => $version->{size})
                ->pack(J => 1     => $version->{mode})
                ->pack(J => 1     => $version->{mtime})
                ->pack(J => 1     => $version->{block_id})
                ->pack(J => 1     => length($version->{symlink_to} // ''))
                ;
         
        $p->pack(a => length($version->{symlink_to})   => $version->{symlink_to} // '') if $version->{symlink_to};
         
        foreach my $part ( @{ $version->{parts} } ) {
                $p      ->pack(H => 128 => $part->{hash})
                        ->pack(J => 1     => $part->{size})
                        ->pack(a => 32    => $part->{aes_key})
                        ->pack(a => 16    => $part->{aes_iv})
                        ;
        }
         
        return $p->data;
}
sub _unpack_version {
        my($version) = @_;
         
        my $p = __PACKAGE__->packer($version);
         
        my %version = (
                backup_id_min   => $p->unpack(J => 1),
                backup_id_max   => $p->unpack(J => 1),
                uid                             => $p->unpack(J => 1),
                gid                             => $p->unpack(J => 1),
                size                    => $p->unpack(J => 1),
                mode                    => $p->unpack(J => 1),
                mtime                   => $p->unpack(J => 1),
                block_id                => $p->unpack(J => 1),
                parts                   => [],
        );
         
        my $symlink_to_length = $p->unpack(J => 1);
        $version{symlink_to} = $symlink_to_length ? $p->unpack(a => $symlink_to_length) : undef;
         
        while(! $p->at_end) {
                push @{ $version{parts} }, {
                        hash    => $p->unpack(H => 128),
                        size    => $p->unpack(J => 1),
                        block_id=> $version{block_id},
                        aes_key => $p->unpack(a => 32),
                        aes_iv  => $p->unpack(a => 16),
                };
        }
         
        return \%version;
}
sub pack {
        my($self, $data) = @_;
         
        my $p = $self->packer();
         
        $p->pack(J => 1   => $data->{parent_id});
        if(exists $data->{id}) {
                $p->pack(J => 1   => $data->{id});
                if(exists $data->{name}) {
                        $p->pack(J => 1   => length($data->{name}));
                        $p->pack(a => length($data->{name})    => $data->{name});
                        if(exists $data->{versions}) {
                                my @versions = map { _pack_version($_) } @{ $data->{versions} };
                                $p->pack(J => 1                                   => scalar(@versions));
                                $p->pack(J => scalar(@versions) => map { length($_) } @versions);
                                $p->pack(a => '*'                         => $_) foreach @versions;
                        }
                }
        }
        return $p->data;
}
sub unpack {
        my($self, $data) = @_;
         
        my $p = $self->packer($data);
         
        return {
                parent_id       => $p->unpack(J => 1),
                id                      => $p->unpack(J => 1),
                name            => $p->unpack(a => $p->unpack(J => 1)),
                versions        => [ map {_unpack_version $_} map { $p->unpack(a => $_) } map { $p->unpack(J => 1) } 1 .. $p->unpack(J => 1) ],
        };
}
my $find_by_parent_id_name_cache_parent_id = 0;
my %find_by_parent_id_name_cache;
sub find_by_parent_id_name {
        my($self, $parent_id, $name) = @_;
         
        if(! $find_by_parent_id_name_cache_parent_id or $find_by_parent_id_name_cache_parent_id != $parent_id) {
                %find_by_parent_id_name_cache = map {$_->{name} => $_} map {@$_} $self->find_all({parent_id => $parent_id});
                $find_by_parent_id_name_cache_parent_id = $parent_id;
        }
         
        return $find_by_parent_id_name_cache{ $name };
}
sub delete {
        my $self = shift;
        %find_by_parent_id_name_cache = ();
        $find_by_parent_id_name_cache_parent_id = 0;
        return $self->SUPER::delete(@_);
}
1;