File Coverage

blib/lib/Parse/RPM/Spec.pm
Criterion Covered Total %
statement 43 46 93.4
branch 11 16 68.7
condition n/a
subroutine 9 9 100.0
pod 1 2 50.0
total 64 73 87.6


line stmt bran cond sub pod time code
1             package Parse::RPM::Spec;
2              
3 1     1   73824 use 5.006000;
  1         4  
4 1     1   6 use strict;
  1         3  
  1         31  
5 1     1   7 use warnings;
  1         2  
  1         37  
6              
7 1     1   7 use Carp;
  1         2  
  1         69  
8 1     1   604 use Moose;
  1         501219  
  1         7  
9              
10             our $VERSION = 'v1.1.1';
11              
12             has file => ( is => 'ro', isa => 'Str', required => 1 );
13             has name => ( is => 'rw', isa => 'Str' );
14             has version => ( is => 'rw', isa => 'Str' );
15             has epoch => ( is => 'rw', isa => 'Str' );
16             has release => ( is => 'rw', isa => 'Str' );
17             has summary => ( is => 'rw', isa => 'Str' );
18             has license => ( is => 'rw', isa => 'Str' );
19             has group => ( is => 'rw', isa => 'Str' );
20             has url => ( is => 'rw', isa => 'Str' );
21             has source => ( is => 'rw', isa => 'ArrayRef[Str]', default => sub { [] } );
22             has buildroot => ( is => 'rw', isa => 'Str' );
23             has buildarch => ( is => 'rw', isa => 'Str' );
24             has buildrequires => ( is => 'rw', isa => 'ArrayRef[Str]', default => sub { [] } );
25             has requires => ( is => 'rw', isa => 'ArrayRef[Str]', default => sub { [] } );
26             has [ qw( excluderach exclusivearch excludeos exclusiveos ) ]
27             => ( is => 'rw', isa => 'Str' );
28              
29             has parse_spec => (
30             is => 'ro',
31             isa => 'HashRef',
32             lazy_build => 1,
33             );
34              
35             sub _build_parse_spec {
36             return {
37 1     1   80 scalars => {
38             name => qr[^Name:\s+(\S+)],
39             version => qr[^Version:\s+(\S+)],
40             epoch => qr[^Epoch:\s+(\S+)],
41             release => qr[^Release:\s+(\S+)],
42             summary => qr[^Summary:\s+(.+)],
43             license => qr[^License:\s+(.+)],
44             group => qr[^Group:\s+(\S+)],
45             url => qr[^URL:\s+(\S+)],
46             buildroot => qr[^BuildRoot:\s+(\S+)],
47             buildarch => qr[^BuildArch:\s+(\S+)],
48             excludearch => qr[^ExcludeArch:\s+(\S+)],
49             exclusivearch => qr[^ExclusiveArch:\s+(\S+)],
50             excludeos => qr[^ExcludeOS:\s+(\S+)],
51             exclusiveos => qr[^ExclusiveOS:\s+(\S+)],
52             },
53             arrays => {
54             source => qr[^Source\d*:\s+(\S+)],
55             buildrequires => qr[^BuildRequires:\s+(.+)],
56             requires => qr[^Requires:\s+(.+)],
57             },
58             };
59             }
60              
61             sub BUILD {
62 3     3 0 8 my $self = shift;
63              
64 3         12 $self->parse_file;
65              
66 1         33 return $self;
67             }
68              
69             sub parse_file {
70 3     3 1 6 my $self = shift;
71              
72 3 50       10 $self->file(shift) if @_;
73              
74 3         84 my $file = $self->file;
75              
76 3 50       9 unless (defined $file) {
77 0         0 croak "No spec file to parse\n";
78             }
79              
80 3 100       76 unless (-e $file) {
81 2         62 croak "Spec file $file doesn't exist\n";
82             }
83              
84 1 50       16 unless (-r $file) {
85 0         0 croak "Cannot read spec file $file\n";
86             }
87              
88 1 50       15 unless (-s $file) {
89 0         0 croak "Spec file $file is empty\n";
90             }
91              
92 1 50       48 open my $fh, '<', $file or croak "Cannot open $file: $!\n";
93              
94 1         46 my $scalars = $self->parse_spec->{scalars};
95 1         25 my $arrays = $self->parse_spec->{arrays};
96              
97 1         64 LINE: while (<$fh>) {
98 50         146 foreach my $attr (keys %$scalars) {
99 620 100       1514 if (/$scalars->{$attr}/) {
100 11         346 $self->$attr($1);
101 11         69 next LINE;
102             }
103             }
104              
105 39         89 foreach my $attr (keys %$arrays) {
106 114 100       325 if (/$arrays->{$attr}/) {
107 4         5 push @{$self->$attr}, $1;
  4         138  
108 4         16 next LINE;
109             }
110             }
111             }
112              
113 1         15 return $self;
114             }
115              
116 1     1   8729 no Moose;
  1         3  
  1         6  
117             __PACKAGE__->meta->make_immutable;
118              
119             1;
120             __END__
121              
122             =head1 NAME
123              
124             Parse::RPM::Spec - Perl extension to parse RPM spec files.
125              
126             =head1 SYNOPSIS
127              
128             use Parse::RPM::Spec;
129              
130             my $spec = Parse::RPM::Spec->new( { file => 'some_package.spec' } );
131              
132             print $spec->name; # some_package
133             print $spec->version; # 0.01 (for example)
134              
135             =head1 DESCRIPTION
136              
137             RPM is the package management system used on Linux distributions based on
138             Red Hat Linux. These days that includes Fedora, Red Hat Enterprise Linux,
139             Centos, SUSE, Mandriva and many more.
140              
141             RPMs are build from the source of a packages along with a spec file. The
142             spec file controls how the RPM is built.
143              
144             This module creates Perl objects which model spec files. Currently it gives
145             you simple access to various pieces of information from the spec file.
146              
147             =head1 CAVEAT
148              
149             This is still in development. I particular it doesn't currently parse all of
150             a spec file. It just does the bits that I currently use. I will be adding
151             support for the rest of the file very soon.
152              
153             =head1 METHODS
154              
155             =head2 $spec = Parse::RPM::Spec->new('some_package.spec')
156              
157             Creates a new Parse::RPM::Spec object. Takes one mandatory parameter which
158             is the path to the spec file that you are interested in. Throws an exception
159             if it doesn't find a valid spec.
160              
161             =head2 $spec->parse_file('some_package.spec')
162              
163             Parses the given spec file. This is called as part of the initialisation
164             carried out by the C<new> method, so there is generally no need to call it
165             yourself.
166              
167             =head2 $spec->file, $spec->name, $spec->version, $spec->epoch, $spec->release, $spec->summary, $spec->license, $spec->group, $spec->url, $spec->source, $spec->buildroot, $spec->buildarch, $spec->buildrequires, $spec->requires
168              
169             Attribute accessors for the spec file object. Each one returns a piece of
170             information from the spec file header. The C<source>, C<buildrequires>
171             and C<requires> methods are slightly different. Because these keys can have
172             multiple values, they return a reference to an array of values.
173              
174             =head2 Parse::RPM::Spec->meta
175              
176             Moose-provided class method for introspection. Generally not needed
177             by users.
178              
179             =head2 EXPORT
180              
181             None.
182              
183             =head1 TO DO
184              
185             Plenty still to do here. Firstly, and most importantly, parsing the rest
186             of the spec file.
187              
188             =head1 SEE ALSO
189              
190             =over 4
191              
192             =item *
193              
194             Red Hat RPM Guide - L<http://docs.fedoraproject.org/drafts/rpm-guide-en/index.html>
195              
196             =item *
197              
198             Maximum RPM - L<http://www.rpm.org/max-rpm/s1-rpm-file-format-rpm-file-format.html>
199              
200             =back
201              
202             =head1 AUTHOR
203              
204             Dave Cross, E<lt>dave@mag-sol.com<gt>
205              
206             =head1 COPYRIGHT AND LICENSE
207              
208             Copyright (C) 2008 by Magnum Solutions Ltd.
209              
210             This library is free software; you can redistribute it and/or modify
211             it under the same terms as Perl itself, either Perl version 5.10.0 or,
212             at your option, any later version of Perl 5 you may have available.
213              
214             =cut