1# Copyright © 2014-2015 Guillem Jover <guillem@debian.org>
2#
3# This program is free software; you can redistribute it and/or modify
4# it under the terms of the GNU General Public License as published by
5# the Free Software Foundation; either version 2 of the License, or
6# (at your option) any later version.
7#
8# This program is distributed in the hope that it will be useful,
9# but WITHOUT ANY WARRANTY; without even the implied warranty of
10# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
11# GNU General Public License for more details.
12#
13# You should have received a copy of the GNU General Public License
14# along with this program.  If not, see <https://www.gnu.org/licenses/>.
15
16package Dpkg::Dist::Files;
17
18use strict;
19use warnings;
20
21our $VERSION = '0.01';
22
23use IO::Dir;
24
25use Dpkg::Gettext;
26use Dpkg::ErrorHandling;
27
28use parent qw(Dpkg::Interface::Storable);
29
30sub new {
31    my ($this, %opts) = @_;
32    my $class = ref($this) || $this;
33
34    my $self = {
35        options => [],
36        files => {},
37    };
38    foreach my $opt (keys %opts) {
39        $self->{$opt} = $opts{$opt};
40    }
41    bless $self, $class;
42
43    return $self;
44}
45
46sub reset {
47    my $self = shift;
48
49    $self->{files} = {};
50}
51
52sub parse_filename {
53    my ($self, $fn) = @_;
54
55    my $file;
56
57    if ($fn =~ m/^(([-+:.0-9a-z]+)_([^_]+)_([-\w]+)\.([a-z0-9.]+))$/) {
58        $file->{filename} = $1;
59        $file->{package} = $2;
60        $file->{version} = $3;
61        $file->{arch} = $4;
62        $file->{package_type} = $5;
63    } elsif ($fn =~ m/^([-+:.,_0-9a-zA-Z~]+)$/) {
64        $file->{filename} = $1;
65    } else {
66        $file = undef;
67    }
68
69    return $file;
70}
71
72sub parse {
73    my ($self, $fh, $desc) = @_;
74    my $count = 0;
75
76    local $_;
77    binmode $fh;
78
79    while (<$fh>) {
80        chomp;
81
82        my $file;
83
84        if (m/^(\S+) (\S+) (\S+)((?:\s+[0-9a-z-]+=\S+)*)$/) {
85            $file = $self->parse_filename($1);
86            error(g_('badly formed package name in files list file, line %d'), $.)
87                unless defined $file;
88            $file->{section} = $2;
89            $file->{priority} = $3;
90            my $attrs = $4;
91            $file->{attrs} = { map { split /=/ } split ' ', $attrs };
92        } else {
93            error(g_('badly formed line in files list file, line %d'), $.);
94        }
95
96        if (defined $self->{files}->{$file->{filename}}) {
97            warning(g_('duplicate files list entry for file %s (line %d)'),
98                    $file->{filename}, $.);
99        } else {
100            $count++;
101            $self->{files}->{$file->{filename}} = $file;
102        }
103    }
104
105    return $count;
106}
107
108sub load_dir {
109    my ($self, $dir) = @_;
110
111    my $count = 0;
112    my $dh = IO::Dir->new($dir) or syserr(g_('cannot open directory %s'), $dir);
113
114    while (defined(my $file = $dh->read)) {
115        my $pathname = "$dir/$file";
116        next unless -f $pathname;
117        $count += $self->load($pathname);
118    }
119
120    return $count;
121}
122
123sub get_files {
124    my $self = shift;
125
126    return map { $self->{files}->{$_} } sort keys %{$self->{files}};
127}
128
129sub get_file {
130    my ($self, $filename) = @_;
131
132    return $self->{files}->{$filename};
133}
134
135sub add_file {
136    my ($self, $filename, $section, $priority, %attrs) = @_;
137
138    my $file = $self->parse_filename($filename);
139    error(g_('invalid filename %s'), $filename) unless defined $file;
140    $file->{section} = $section;
141    $file->{priority} = $priority;
142    $file->{attrs} = \%attrs;
143
144    $self->{files}->{$filename} = $file;
145
146    return $file;
147}
148
149sub del_file {
150    my ($self, $filename) = @_;
151
152    delete $self->{files}->{$filename};
153}
154
155sub filter {
156    my ($self, %opts) = @_;
157    my $remove = $opts{remove} // sub { 0 };
158    my $keep = $opts{keep} // sub { 1 };
159
160    foreach my $filename (keys %{$self->{files}}) {
161        my $file = $self->{files}->{$filename};
162
163        if (not $keep->($file) or $remove->($file)) {
164            delete $self->{files}->{$filename};
165        }
166    }
167}
168
169sub output {
170    my ($self, $fh) = @_;
171    my $str = '';
172
173    binmode $fh if defined $fh;
174
175    foreach my $filename (sort keys %{$self->{files}}) {
176        my $file = $self->{files}->{$filename};
177        my $entry = "$filename $file->{section} $file->{priority}";
178
179        if (exists $file->{attrs}) {
180            foreach my $attr (sort keys %{$file->{attrs}}) {
181                $entry .= " $attr=$file->{attrs}->{$attr}";
182            }
183        }
184
185        $entry .= "\n";
186
187        print { $fh } $entry if defined $fh;
188        $str .= $entry;
189    }
190
191    return $str;
192}
193
1941;
195