File Coverage

blib/lib/Debian/DpkgLists.pm
Criterion Covered Total %
statement 43 43 100.0
branch 9 12 75.0
condition 1 3 33.3
subroutine 11 11 100.0
pod 4 4 100.0
total 68 73 93.1


line stmt bran cond sub pod time code
1             package Debian::DpkgLists;
2              
3 2     2   1603935 use strict;
  2         8  
  2         199  
4 2     2   19 use warnings;
  2         4  
  2         290  
5              
6             our $VERSION = '0.71';
7              
8 2     2   100 use Cwd;
  2         14  
  2         2351  
9              
10             =head1 NAME
11              
12             Debian::DpkgLists - scan /var/lib/dpkg/info/*.list for files/patterns
13              
14             =head1 SYNOPSIS
15              
16             my @packages = Debian::DpkgLists->scan_full_path('/full/file/path');
17             my @packages = Debian::DpkgLists->scan_partial_path('file/path');
18             my @packages = Debian::DpkgLists->scan_pattern(qr{freedom$});
19             my @packages = Debian::DpkgLists->scan_perl_mod('Some::Module');
20              
21             =head1 DESCRIPTION
22              
23             B is a module for easy searching of L's package
24             file lists. These are located in F and contain a
25             simple list of full file names (including the leading slash).
26              
27             There are a couple of different class methods for searching by full or partial
28             path, a regular expression or a Perl module name.
29              
30             Note that dpkg's file lists represent only dpkg's idea of what is installed on
31             the system. If you want to also search in packages, available from the Debian
32             archive but not installed locally, see L.
33              
34             =cut
35              
36             sub _cat_lists
37             {
38 6     6   21 my ( $class, $callback ) = @_;
39 6         212110 while ( defined( my $f = ) ) {
40 1584         2326 my $pkg = $f;
41 1584         6901 $pkg =~ s{^/var/lib/dpkg/info/}{};
42 1584         5032 $pkg =~ s/\.list$//;
43 1584 50       58911 open my $fh, '<', $f or die "open($f): $!\n";
44 1584         675320 while ( defined( my $l = <$fh> ) ) {
45 136752         152900 chomp $l;
46 136752         212750 &$callback( $pkg, $l );
47             }
48             }
49             }
50              
51             =head1 CLASS-METHODS
52              
53             =over
54              
55             =item scan_full_path ( I )
56              
57             Scans dpkg file lists for files, whose full path is equal to I. Use when
58             you have the full path of the file you want, like C.
59              
60             Returns a (possibly empty) list of packages containing I.
61              
62             =cut
63              
64             sub scan_full_path
65             {
66 1     1 1 1338124 my ( $class, $path ) = @_;
67              
68 1         6 my %found;
69             $class->_cat_lists(
70             sub {
71 22792 100   22792   201185 $found{ $_[0] } = 1 if $_[1] eq $path;
72             }
73 1         24 );
74              
75 1         145 return sort keys %found;
76             }
77              
78             =item scan_partial_path ( I )
79              
80             Scans dpkg file lists for files, whose full path ends with I. Use when
81             you only care about the file name or other trailing portion of the full path
82             like C (matches C and C).
83              
84             Returns a (possibly empty) list of packages containing files whose full path
85             ends with I.
86              
87             =cut
88              
89             sub scan_partial_path {
90 1     1 1 6 my ( $class, $path ) = @_;
91              
92 1         5 my $start = -length($path);
93 1         4 my %result;
94             $class->_cat_lists(
95             sub {
96 22792 100   22792   75632 $result{ $_[0] } = 1 if substr( $_[1], $start ) eq $path;
97             }
98 1         28 );
99              
100 1         16 return sort keys %result;
101             }
102              
103             =item scan_pattern ( I )
104              
105             Scans dpkg file lists for files, whose full path matched I.
106              
107             Returns a (possibly empty) list of packages containing files whose full path
108             matches I.
109              
110             =cut
111              
112             sub scan_pattern {
113 4     4 1 737 my ( $class, $pat ) = @_;
114              
115 4         9 my %result;
116             $class->_cat_lists(
117             sub {
118 91168 100   91168   385268 $result{ $_[0] } = 1 if $_[1] =~ $pat;
119             }
120 4         36 );
121              
122 4         77 return sort keys %result;
123             }
124              
125             =item scan_perl_mod ( I )
126              
127             Scans dpkg file lists for files, corresponding to given I. This
128             is a shorthand method for L with a pattern that matches
129             C in all directories in C<@INC>.
130              
131             Returns a (possibly empty) list of packages containing possible I
132             files.
133              
134             =cut
135              
136             sub scan_perl_mod {
137 3     3 1 7354 my ( $class, $mod ) = @_;
138              
139 3         12 $mod =~ s{::}{/}g;
140 3 50       21 $mod .= ".pm" unless $mod =~ /\.pm$/;
141              
142 36 50 33     300 my @dirs = grep { defined and m{^/} and not m{/usr/local/} }
143 3         15 map { Cwd::realpath($_) } @INC;
  36         3033  
144 3         120 my $re
145             = "^(?:"
146             . join( '|', map( quotemeta($_), @dirs ) ) . ")/"
147             . quotemeta($mod) . "\$";
148 3         491 $re = qr($re);
149              
150 3         23 return $class->scan_pattern($re);
151             }
152              
153             =back
154              
155             =head1 AUTHOR
156              
157             =over 4
158              
159             =item Damyan Ivanov
160              
161             =back
162              
163             =head1 COPYRIGHT & LICENSE
164              
165             =over 4
166              
167             =item Copyright (C) 2010 Damyan Ivanov
168              
169             =back
170              
171             This program is free software; you can redistribute it and/or modify it under
172             the terms of the GNU General Public License version 2 as published by the Free
173             Software Foundation.
174              
175             This program is distributed in the hope that it will be useful, but WITHOUT ANY
176             WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR A
177             PARTICULAR PURPOSE. See the GNU General Public License for more details.
178              
179             You should have received a copy of the GNU General Public License along with
180             this program; if not, write to the Free Software Foundation, Inc., 51 Franklin
181             Street, Fifth Floor, Boston, MA 02110-1301 USA.
182              
183             =cut
184              
185             1;