File Coverage

blib/lib/Youri/Package/RPM.pm
Criterion Covered Total %
statement 18 40 45.0
branch 0 26 0.0
condition 0 3 0.0
subroutine 6 11 54.5
pod 5 5 100.0
total 29 85 34.1


line stmt bran cond sub pod time code
1             # $Id: RPM.pm 2391 2013-01-03 20:53:57Z guillomovitch $
2             package Youri::Package::RPM;
3              
4             =head1 NAME
5              
6             Youri::Package::RPM - Base class for all RPM-based package implementation
7              
8             =head1 DESCRIPTION
9              
10             This bases class factorize code between various RPM-based package
11             implementation.
12              
13             =cut
14              
15 1     1   58293 use strict;
  1         2  
  1         33  
16 1     1   7 use warnings;
  1         2  
  1         28  
17 1     1   6 use base 'Youri::Package';
  1         5  
  1         573  
18 1     1   7 use version; our $VERSION = qv('0.2.1');
  1         1  
  1         4  
19 1     1   68 use Carp;
  1         2  
  1         54  
20 1     1   6 use UNIVERSAL::require;
  1         3  
  1         9  
21              
22             =head2 get_wrapper_class
23              
24             Returns the name of a class corresponding to currently available perl RPM
25             bindings:
26              
27             =over
28              
29             =item C if RPM4 is available
30              
31             =item C if RPM is available
32              
33             =item C if URPM is available
34              
35             =back
36              
37             This allow to write binding-independant code, by using
38             methods of this class instead of using bindings-specific
39             functions.
40              
41             =over
42              
43             =item set_verbosity
44              
45             =item install_srpm
46              
47             =item add_macro
48              
49             =item expand_macro
50              
51             =item new_header
52              
53             =item new_spec
54              
55             =item new_transaction
56              
57             =back
58              
59             =head2 set_verbosity
60              
61             This method calls underlying binding corresponding function.
62              
63             =head2 install_srpm
64              
65             This method calls underlying binding corresponding function.
66              
67             =head2 add_macro
68              
69             This method calls underlying binding corresponding function.
70              
71             =head2 expand_macro
72              
73             This method calls underlying binding corresponding function.
74              
75             =head2 new_header
76              
77             This method calls the constructor of the underlying binding Header class.
78              
79             =head2 new_spec
80              
81             This method calls the constructor of the underlying binding Spec class.
82              
83             =head2 new_transaction
84              
85             This method calls the constructor of the underlying binding Transaction class.
86              
87             =cut
88              
89             sub get_wrapper_class {
90 0 0   0 1   if (RPM4->require()) {
91 0           Youri::Package::RPM::RPM4->require();
92 0           return 'Youri::Package::RPM::RPM4';
93             }
94              
95 0 0         if (RPM->require()) {
96 0           Youri::Package::RPM::RPM->require();
97 0           return 'Youri::Package::RPM::RPM';
98             }
99              
100 0 0         if (URPM->require()) {
101 0           Youri::Package::RPM::URPM->require();
102 0           return 'Youri::Package::RPM::URPM';
103             }
104              
105 0           croak "No RPM bindings available";
106             }
107              
108             sub get_pattern {
109 0     0 1   my ($class, $name, $version, $release, $arch) = @_;
110              
111 0 0         return $class->get_unquoted_pattern(
    0          
    0          
    0          
112             $name ? quotemeta($name) : undef,
113             $version ? quotemeta($version) : undef,
114             $release ? quotemeta($release) : undef,
115             $arch ? quotemeta($arch) : undef
116             );
117             }
118              
119             sub get_unquoted_pattern {
120 0     0 1   my ($class, $name, $version, $release, $arch) = @_;
121              
122             return
123 0 0         ($name ? $name : '[\w-]+' ).
    0          
    0          
    0          
124             '-' .
125             ($version ? $version : '[^-]+' ).
126             '-' .
127             ($release ? $release : '[^-]+' ).
128             '\.' .
129             ($arch ? $arch : '\w+' ).
130             '\.rpm';
131             }
132              
133             sub as_file {
134 0     0 1   my ($self) = @_;
135 0 0         croak "Not a class method" unless ref $self;
136              
137 0           return $self->{_file};
138             }
139              
140             sub is_debug {
141 0     0 1   my ($self) = @_;
142 0 0         croak "Not a class method" unless ref $self;
143              
144 0           my $name = $self->get_name();
145 0           my $group = $self->get_tag('group');
146              
147             # debug packages names must end in -debug or -debuginfo
148             return
149 0   0       $group eq 'Development/Debug' &&
150             ($name =~ /-debug$/ || $name =~ /-debuginfo$/);
151             }
152              
153             1;