File Coverage

blib/lib/FreeBSD/Ports.pm
Criterion Covered Total %
statement 6 53 11.3
branch 0 16 0.0
condition n/a
subroutine 2 5 40.0
pod 3 3 100.0
total 11 77 14.2


line stmt bran cond sub pod time code
1             package FreeBSD::Ports;
2              
3 1     1   19982 use warnings;
  1         3  
  1         35  
4 1     1   6 use strict;
  1         2  
  1         834  
5              
6             =head1 NAME
7              
8             FreeBSD::Ports - A simple wrapper for working with the FreeBSD ports.
9              
10             =head1 VERSION
11              
12             Version 0.0.0
13              
14             =cut
15              
16             our $VERSION = '0.0.0';
17              
18              
19             =head1 SYNOPSIS
20              
21             use FreeBSD::Ports;
22              
23             my $ports = FreeBSD::Ports->new();
24              
25              
26             =head1 METHODES
27              
28             =head2 new
29              
30             =cut
31              
32             sub new{
33 0     0 1   my %args;
34 0 0         if (defined($_[1])) {
35 0           %args= %{$_[1]};
  0            
36             }
37              
38             #create the object that will be passed around
39 0           my $self = {error=>undef, exitInt=>undef, errorString=>'',
40             systemInt=>undef};
41 0           bless $self;
42              
43             #figures out what to use for the ports dir
44 0 0         if ($args{portsdir}) {
45 0           $self->{portsdir}=$args{portsdir};
46             }else {
47 0 0         if(!defined($ENV{PORTSDIR})){
48 0           $self->{portsdir}="/usr/ports/";
49             }else{
50 0           $self->{portsdir}=$ENV{PORTSDIR};
51             }
52             }
53              
54 0           return $self;
55             }
56              
57             =head2 do
58              
59             This runs a specified make type. Please see ports(7) for
60             more information on the available types.
61              
62             Three arguements are accepted. The first is the type.
63             The second is the port. The third is a string containing
64             any options to be appended.
65              
66             $ports->do('install', 'www/firefox');
67             if($ports->{error}){
68             print "Errot!\n;";
69             }
70              
71             =cut
72              
73             sub do{
74 0     0 1   my $self=$_[0];
75 0           my $type=$_[1];
76 0           my $port=$_[2];
77 0           my $options=$_[3];
78              
79 0 0         if (!defined($options)) {
80 0           $options='';
81             }
82              
83 0           my $sub='do';
84              
85             #make sure we cd to portsdir
86 0 0         if (!chdir($self->{portsdir})) {
87 0           my $error='The portsdir, "'.$self->portsdir.'", could not be CDed to';
88 0           warn('FreeBSD-Ports '.$sub.':3: '.$error);
89 0           $self->{error}=3;
90 0           $self->{errorString}=$error;
91 0           return undef;
92             }
93              
94             #make sure we can cd to the port...
95             #we do this after going to the portsdir as it is nice to be able to
96             #differentiate between this and the previous
97 0 0         if (!chdir($port)) {
98 0           my $error='Could CD to the port, "'.$port.
99             '", from the portsdir, "'.$self->{portsdir}.'"';
100 0           warn('FreeBSD-Ports '.$sub.':2: '.$error);
101 0           $self->{error}=2;
102 0           $self->{errorString}=$error;
103 0           return undef;
104             }
105              
106 0           system('make '.$type.' '.$options);
107             #make sure it worked
108 0           $self->{systemInt}=$?;
109 0           $self->{exitInt}=$self->{systemInt} >> 8;
110 0 0         if ($self->{systemInt} ne '0') {
111 0           my $error='"make '.$type.' '.$options.'" errored with a return "'.$self->{systemInt}.'"';
112             #we only add the returned int if it is not -1... other wise we get a big
113             #meaningless number tacked on
114 0 0         if ($self->{systemInt} ne '-1') {
115 0           $error=$error.', "'.$self->{exitInt}.'"';
116             }
117 0           warn('FreeBSD-Ports do:4: '.$error);
118 0           $self->{error}=4;
119 0           $self->{errorString}=$error;
120 0           return undef;
121             }
122              
123 0           return 1;
124             }
125              
126             =head2 errorblank
127              
128             This blanks the error storage and is only meant for internal usage.
129              
130             It does the following.
131              
132             $self->{error}=undef;
133             $self->{errorString}='';
134              
135             =cut
136              
137             #blanks the error flags
138             sub errorblank{
139 0     0 1   my $self=$_[0];
140              
141 0           $self->{error}=undef;
142 0           $self->{errorString}='';
143              
144 0           return 1;
145             }
146              
147             =head1 ERROR CODES
148              
149             This is contained in $port->{error}. A description can be found in
150             $ports->{errorString}.
151              
152             =head2 1
153              
154             Command failed.
155              
156             =head2 2
157              
158             Port does not exist.
159              
160             =head2 3
161              
162             Portsdir does not exist.
163              
164             =head2 4
165              
166             Make errored.
167              
168             =head1 AUTHOR
169              
170             Zane C. Bowers, C<< >>
171              
172             =head1 BUGS
173              
174             Please report any bugs or feature requests to C, or through
175             the web interface at L. I will be notified, and then you'll
176             automatically be notified of progress on your bug as I make changes.
177              
178              
179              
180              
181             =head1 SUPPORT
182              
183             You can find documentation for this module with the perldoc command.
184              
185             perldoc FreeBSD::Ports
186              
187              
188             You can also look for information at:
189              
190             =over 4
191              
192             =item * RT: CPAN's request tracker
193              
194             L
195              
196             =item * AnnoCPAN: Annotated CPAN documentation
197              
198             L
199              
200             =item * CPAN Ratings
201              
202             L
203              
204             =item * Search CPAN
205              
206             L
207              
208             =back
209              
210              
211             =head1 ACKNOWLEDGEMENTS
212              
213              
214             =head1 COPYRIGHT & LICENSE
215              
216             Copyright 2008 Zane C. Bowers, all rights reserved.
217              
218             This program is free software; you can redistribute it and/or modify it
219             under the same terms as Perl itself.
220              
221              
222             =cut
223              
224             1; # End of FreeBSD::Ports