File Coverage

lib/DPKG/Log/Analyse/Package.pm
Criterion Covered Total %
statement 17 19 89.4
branch n/a
condition n/a
subroutine 7 7 100.0
pod n/a
total 24 26 92.3


line stmt bran cond sub pod time code
1             package DPKG::Log::Analyse::Package;
2             BEGIN {
3 2     2   23273 $DPKG::Log::Analyse::Package::VERSION = '1.20';
4             }
5              
6              
7             =head1 NAME
8              
9             DPKG::Log::Analyse::Package - Describe a package as analysed from a dpkg.log
10              
11             =head1 VERSION
12              
13             version 1.20
14              
15             =head1 SYNOPSIS
16              
17             use DPKG::Log;
18              
19             my $package = DPKG::Log::Analyse::Package->new('package' => 'foobar');
20              
21             =head1 DESCRIPTION
22              
23             This module is used to analyse a dpkg log.
24              
25             =head1 METHODS
26              
27             =over 4
28              
29             =cut
30              
31 2     2   14 use strict;
  2         3  
  2         653  
32 2     2   11 use warnings;
  2         3  
  2         54  
33 2     2   43 use 5.010;
  2         6  
  2         90  
34              
35 2     2   11 use Carp;
  2         3  
  2         177  
36 2     2   414 use DPKG::Log;
  2         5  
  2         57  
37 2     2   3906 use Dpkg::Version;
  0            
  0            
38             use Params::Validate qw(:all);
39              
40             use overload (
41             '""' => 'as_string',
42             'eq' => 'equals',
43             'cmp' => 'compare',
44             '<=>' => 'compare'
45             );
46              
47             =item $package = DPKG::Log::Analyse::Package->new('package' => 'foobar')
48              
49             Returns a new DPKG::Log::Analyse::Package object.
50              
51             =cut
52             sub new {
53             my $package = shift;
54             $package = ref($package) if ref($package);
55              
56             my %params = validate(
57             @_, {
58             'package' => { 'type' => SCALAR },
59             'version' => 0,
60             'previous_version' => 0,
61             'status' => 0
62             }
63             );
64            
65             my $self = {
66             version => "",
67             previous_version => "",
68             status => "",
69             %params
70             };
71              
72             bless($self, $package);
73             return $self;
74             }
75              
76             =item $package_name = $package->name;
77              
78             Returns the name of this package.
79              
80             =cut
81             sub name {
82             my $self = shift;
83             return $self->{package};
84             }
85              
86             =item $package->version
87              
88             Return or set the version of this package.
89              
90             =cut
91             sub version {
92             my ($self, $version) = @_;
93             if ($version) {
94             my $version_obj = Dpkg::Version->new($version);
95             $self->{version} = $version_obj;
96             } else {
97             $version = $self->{version};
98             }
99             return $version;
100             }
101              
102             =item $package->previous_version
103              
104             Return or set the previous version of this package.
105              
106             =cut
107             sub previous_version {
108             my ($self, $previous_version) = @_;
109             if ($previous_version) {
110             my $version_obj = Dpkg::Version->new($previous_version);
111             $self->{previous_version} = $version_obj;
112             } else {
113             $previous_version = $self->{previous_version};
114             }
115             return $previous_version;
116             }
117              
118             =item $package->status
119              
120             Return or set the status of this package.
121              
122             =cut
123             sub status {
124             my ($self, $status) = @_;
125             if ($status) {
126             $self->{status} = $status;
127             } else {
128             $status = $self->{status}
129             }
130             return $status;
131             }
132              
133             =item equals($package1, $package2);
134              
135             =item print "equal" if $package1 eq $package2
136              
137             Compares two packages in their string representation.
138              
139             =cut
140             sub equals {
141             my ($first, $second) = @_;
142             return ($first->as_string eq $second->as_string);
143             }
144              
145              
146             =item compare($package1, $package2)
147              
148             =item print "greater" if $package1 > $package2
149              
150             Compare two packages. See B for details on how
151             the comparison works.
152             =cut
153             sub compare {
154             my ($first, $second) = @_;
155             return -1 if ($first->name ne $second->name);
156             if ((not $first->previous_version) and (not $second->previous_version)) {
157             return ($first->version <=> $second->version);
158             } elsif ((not $first->previous_version) or (not $second->previous_version)) {
159             return -1;
160             } elsif ($first->previous_version != $second->previous_version) {
161             return -1;
162             }
163            
164             return (($first->version <=> $second->version));
165              
166             }
167              
168             =item $package_str = $package->as_string
169              
170             =item printf("Package name: %s", $package);
171              
172             Return this package as a string. This will return the package name
173             and the version (if set) in the form package_name/version.
174             If version is not set, it will return the package name only.
175              
176             =cut
177             sub as_string {
178             my $self = shift;
179              
180             my $string = $self->{package};
181             if ($self->version) {
182             $string = $string . "/" . $self->version;
183             }
184             return $string;
185             }
186              
187             =back
188              
189             =head1 Overloading
190              
191             This module explicitly overloads some operators.
192             Each operand is expected to be a DPKG::Log::Analyse::Package object.
193              
194             The string comparison operators, "eq" or "ne" will use the string value for the
195             comparison.
196              
197             The numerical operators will use the package name and package version for
198             comparison. That means a package1 == package2 if package1->name equals
199             package2->name AND package1->version == package2->version.
200              
201             The module stores versions as Dpkg::Version objects, therefore sorting
202             different versions of the same package will work.
203              
204             This module also overloads stringification returning either the package
205             name if no version is set or "package_name/version" if a version is set.
206              
207             =cut
208              
209             =head1 SEE ALSO
210              
211             L, L
212              
213             =head1 AUTHOR
214              
215             Patrick Schoenfeld .
216              
217             =head1 COPYRIGHT AND LICENSE
218              
219             Copyright (C) 2011 Patrick Schoenfeld
220              
221             This library is free software.
222             You can redistribute it and/or modify it under the same terms as perl itself.
223              
224             =cut
225              
226             1;
227             # vim: expandtab:ts=4:sw=4