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