/[gentoo-perl]/g-cpan/trunk/lib/Gentoo/Config.pm
Gentoo

Contents of /g-cpan/trunk/lib/Gentoo/Config.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 85 - (show annotations) (download) (as text)
Wed Jul 12 15:55:49 2006 UTC (8 years ago) by mcummings
File MIME type: text/x-perl
File size: 5787 byte(s)
Bug 140084 - thanks Moshe!


1 package Gentoo::Config;
2
3 use 5.008007;
4 use strict;
5 use warnings;
6
7 require Exporter;
8
9 our @ISA = qw(Exporter);
10 our @EXPORT = qw(getParamFromFile getFileContents getValue );
11
12 our $VERSION = '0.01';
13
14 sub new {
15 my $self = shift;
16 my $class = ref($self) || $self;
17 return bless {}, $class;
18 }
19
20 # Description:
21 # Returns the value of $param. Expects filecontents in $file.
22 # $valueOfKey = getParamFromFile($filecontents,$key);
23 # e.g.
24 # $valueOfKey = getParamFromFile(getFileContents("/path/to.ebuild","IUSE","firstseen");
25 sub getParamFromFile {
26 my $file = shift;
27 my $param = shift;
28 my $mode = shift; # ("firstseen","lastseen") - default is "lastseen"
29 my $c = 0;
30 my $d = 0;
31 my @lines = ();
32 my @aTmp = (); # temp (a)rray
33 my $sTmp = ""; # temp (s)calar
34 my $text = ""; # complete text/file after being cleaned up and striped
35 my $value = ""; # value of $param
36 my $this = "";
37
38 # - 1. split file in lines >
39 @lines = split( /\n/, $file );
40
41 # - 2 & 3 >
42 for ( $c = 0 ; $c <= $#lines ; $c++ ) {
43
44 # - 2. remove leading and trailing whitespaces and tabs from every line >
45 $lines[$c] =~ s/^[ |\t]+//; # leading whitespaces and tabs
46 $lines[$c] =~ s/[ |\t]+$//; # trailing whitespaces and tabs
47
48 # - 3. remove comments >
49 $lines[$c] =~ s/#(.*)//g;
50
51 if ( $lines[$c] =~ /^$param="(.*)"/ ) {
52
53 # single-line with quotationmarks >
54 $value = $1;
55
56 if ( $mode eq "firstseen" ) {
57
58 # - 6. clean up value >
59 $value =~ s/^[ |\t]+//; # remove leading whitespaces and tabs
60 $value =~ s/[ |\t]+$//; # remove trailing whitespaces and tabs
61 $value =~ s/\t/ /g; # replace tabs with whitespaces
62 $value =~
63 s/ {2,}/ /g; # replace 1+ whitespaces with 1 whitespace
64 return $value;
65 }
66 }
67 elsif ( $lines[$c] =~ /^$param="(.*)/ ) {
68
69 # multi-line with quotationmarks >
70 $value = $1 . " ";
71 for ( $d = $c + 1 ; $d <= $#lines ; $d++ ) {
72
73 # - look for quotationmark >
74 if ( $lines[$d] =~ /(.*)"/ ) {
75
76 # - found quotationmark; append contents and leave loop >
77 $value .= $1;
78 last;
79 }
80 else {
81
82 # - no quotationmark found; append line contents to $value >
83 $value .= $lines[$d] . " ";
84 }
85 }
86
87 if ( $mode eq "firstseen" ) {
88
89 # - 6. clean up value >
90 $value =~ s/^[ |\t]+//; # remove leading whitespaces and tabs
91 $value =~ s/[ |\t]+$//; # remove trailing whitespaces and tabs
92 $value =~ s/\t/ /g; # replace tabs with whitespaces
93 $value =~
94 s/ {2,}/ /g; # replace 1+ whitespaces with 1 whitespace
95 return $value;
96 }
97 }
98 elsif ( $lines[$c] =~ /^$param=(.*)/ ) {
99
100 # - single-line without quotationmarks >
101 $value = $1;
102
103 if ( $mode eq "firstseen" ) {
104
105 # - 6. clean up value >
106 $value =~ s/^[ |\t]+//; # remove leading whitespaces and tabs
107 $value =~ s/[ |\t]+$//; # remove trailing whitespaces and tabs
108 $value =~ s/\t/ /g; # replace tabs with whitespaces
109 $value =~
110 s/ {2,}/ /g; # replace 1+ whitespaces with 1 whitespace
111 return $value;
112 }
113 }
114 }
115
116 # - 6. clean up value >
117 $value =~ s/^[ |\t]+//; # remove leading whitespaces and tabs
118 $value =~ s/[ |\t]+$//; # remove trailing whitespaces and tabs
119 $value =~ s/\t/ /g; # replace tabs with whitespaces
120 $value =~ s/ {2,}/ /g; # replace 1+ whitespaces with 1 whitespace
121
122 return $value;
123 }
124
125 # Description:
126 # Returnvalue is the content of the given file.
127 # $filecontent = getFileContents($file);
128 sub getFileContents {
129 my $content = "";
130
131 open( FH, "<" . $_[0] ) || die( "Cannot open file " . $_[0] );
132 while (<FH>) { $content .= $_; }
133 close(FH);
134 return $content;
135 }
136
137 sub getValue {
138 my $self = shift;
139 my $confVal = shift;
140 my $makeconf = getParamFromFile( getFileContents("/etc/make.conf"),
141 "$confVal", "lastseen" );
142 my $filedata =
143 getFileContents("/etc/make.globals").getFileContents("/etc/make.conf");
144 my $param = getParamFromFile($filedata,$confVal,"lastseen");
145
146 while ($param =~m/\$\{(.+)\}/)
147 {
148 my $fetchparam=getParamFromFile($filedata,$1,"lastseen");
149 $param=~s/\$\{$1\}/$fetchparam/;
150 }
151
152 if ( !$param ) {
153 return undef;
154 }
155 $self->{ lc($confVal) } = $param;
156 }
157
158 sub DESTROY {
159 my ($self) = @_;
160 return if $self->{DESTROY}{__PACKAGE__}++;
161 }
162
163 1;
164
165 __END__
166
167 =pod
168
169 =head1 NAME
170
171 Gentoo::Config - Pull general Gentoo config information
172
173 =head1 SYNOPSIS
174
175 use Gentoo::Config;
176 my $obj = Gentoo::Config->new();
177 my $keywords = $obj->getValue("ACCEPT_KEYWORDS");
178 my $distdir = $obj->getValue("DISTDIR");
179
180 =head1 DESCRIPTION
181
182 The C<Gentoo::Config> class gives you access to the portage configuration
183 variables. In normal use, it checks first the make.conf for a defined value,
184 then secondly the make.globals.
185
186 =head1 CONSTRUCTOR METHODS
187
188 =over 4
189
190 =item my $obj = Gentoo::Config->new();
191
192 Create a new Gentoo Config object.
193
194 =item my $var = $obj->($PORTVAR);
195
196 Get the defined portage variable. Returns a string.
197
198 =back
199
200 =head1 SEE ALSO
201
202 See L<make.conf> for an overview of the variables that are availble for
203 extraction from portage.
204
205 =cut

  ViewVC Help
Powered by ViewVC 1.1.20