Codebase list libparse-plainconfig-perl / c2fc4ef
Imported Upstream version 3.02 Lucas Kanashiro 7 years ago
67 changed file(s) with 5134 addition(s) and 2709 deletion(s). Raw diff Collapse all Expand all
+16
-0
CHANGELOG less more
0 v3.02 (2016/05/26)
1 ------------------
2 --Improved Makefile.PL to better report on requirements
3 --Removed Carp dependency
4 --Added error method to store last error string
5 --Added prototyped method to retrieve all or specific prototyped properties
6
7 v3.00 (2016/05/10)
8 ------------------
9 --Complete rewrite targetted towards ease-of-use for developers
10 --Parsing objects are now subclasses
11 --Added new here document capability
12 --Simplified API
13 --I/O handled by latest Paranoid::IO release
14 --Internal class logic managed by Class::EHierarchy
15
016 v2.06 (2008/07/07)
117 ------------------
218 --write method was always reporting true when it's possible that it could
+0
-9
CREDITS less more
0 Credits (Alphabetically listed):
1 ================================
2
3 --Credit has to be given, as always, to Larry Wall, for starting this
4 train a-rolling. :-)
5 --Stephen Heilbronner for suggesting variable delimiters
6 --Martin Schmitt for suggesting a force-to-scalar option
7 --All those that pointed out my test framework errors ;-)
8
+11
-0
INSTALL less more
0 Installation Instructions:
1 ==========================
2
3 If you have root access you can simply execute:
4
5 perl Makefile.PL && make && make install
6
7 If you're installing this in your own personal space use something akin to:
8
9 perl Makefile.PL LIB=~/lib && make && make install
10
+372
-333
LICENSE less more
0 GNU GENERAL PUBLIC LICENSE
1 Version 2, June 1991
2
3 Copyright (C) 1989, 1991 Free Software Foundation, Inc.
4 675 Mass Ave, Cambridge, MA 02139, USA
5 Everyone is permitted to copy and distribute verbatim copies
6 of this license document, but changing it is not allowed.
7
8 Preamble
9
10 The licenses for most software are designed to take away your
11 freedom to share and change it. By contrast, the GNU General Public
12 License is intended to guarantee your freedom to share and change free
13 software--to make sure the software is free for all its users. This
14 General Public License applies to most of the Free Software
15 Foundation's software and to any other program whose authors commit to
16 using it. (Some other Free Software Foundation software is covered by
17 the GNU Library General Public License instead.) You can apply it to
0
1 Terms of Perl itself
2
3 a) the GNU General Public License as published by the Free
4 Software Foundation; either version 1, or (at your option) any
5 later version, or
6 b) the "Artistic License"
7
8 ----------------------------------------------------------------------------
9
10 The General Public License (GPL)
11 Version 2, June 1991
12
13 Copyright (C) 1989, 1991 Free Software Foundation, Inc. 675 Mass Ave,
14 Cambridge, MA 02139, USA. Everyone is permitted to copy and distribute
15 verbatim copies of this license document, but changing it is not allowed.
16
17 Preamble
18
19 The licenses for most software are designed to take away your freedom to share
20 and change it. By contrast, the GNU General Public License is intended to
21 guarantee your freedom to share and change free software--to make sure the
22 software is free for all its users. This General Public License applies to most of
23 the Free Software Foundation's software and to any other program whose
24 authors commit to using it. (Some other Free Software Foundation software is
25 covered by the GNU Library General Public License instead.) You can apply it to
1826 your programs, too.
1927
20 When we speak of free software, we are referring to freedom, not
21 price. Our General Public Licenses are designed to make sure that you
22 have the freedom to distribute copies of free software (and charge for
23 this service if you wish), that you receive source code or can get it
24 if you want it, that you can change the software or use pieces of it
25 in new free programs; and that you know you can do these things.
26
27 To protect your rights, we need to make restrictions that forbid
28 anyone to deny you these rights or to ask you to surrender the rights.
29 These restrictions translate to certain responsibilities for you if you
30 distribute copies of the software, or if you modify it.
31
32 For example, if you distribute copies of such a program, whether
33 gratis or for a fee, you must give the recipients all the rights that
34 you have. You must make sure that they, too, receive or can get the
35 source code. And you must show them these terms so they know their
36 rights.
37
38 We protect your rights with two steps: (1) copyright the software, and
39 (2) offer you this license which gives you legal permission to copy,
40 distribute and/or modify the software.
41
42 Also, for each author's protection and ours, we want to make certain
43 that everyone understands that there is no warranty for this free
44 software. If the software is modified by someone else and passed on, we
45 want its recipients to know that what they have is not the original, so
46 that any problems introduced by others will not reflect on the original
47 authors' reputations.
48
49 Finally, any free program is threatened constantly by software
50 patents. We wish to avoid the danger that redistributors of a free
51 program will individually obtain patent licenses, in effect making the
52 program proprietary. To prevent this, we have made it clear that any
53 patent must be licensed for everyone's free use or not licensed at all.
54
55 The precise terms and conditions for copying, distribution and
56 modification follow.
57
58 GNU GENERAL PUBLIC LICENSE
59 TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
60
61 0. This License applies to any program or other work which contains
62 a notice placed by the copyright holder saying it may be distributed
63 under the terms of this General Public License. The "Program", below,
64 refers to any such program or work, and a "work based on the Program"
65 means either the Program or any derivative work under copyright law:
66 that is to say, a work containing the Program or a portion of it,
67 either verbatim or with modifications and/or translated into another
68 language. (Hereinafter, translation is included without limitation in
69 the term "modification".) Each licensee is addressed as "you".
70
71 Activities other than copying, distribution and modification are not
72 covered by this License; they are outside its scope. The act of
73 running the Program is not restricted, and the output from the Program
74 is covered only if its contents constitute a work based on the
75 Program (independent of having been made by running the Program).
76 Whether that is true depends on what the Program does.
77
78 1. You may copy and distribute verbatim copies of the Program's
79 source code as you receive it, in any medium, provided that you
80 conspicuously and appropriately publish on each copy an appropriate
81 copyright notice and disclaimer of warranty; keep intact all the
82 notices that refer to this License and to the absence of any warranty;
83 and give any other recipients of the Program a copy of this License
28 When we speak of free software, we are referring to freedom, not price. Our
29 General Public Licenses are designed to make sure that you have the freedom
30 to distribute copies of free software (and charge for this service if you wish), that
31 you receive source code or can get it if you want it, that you can change the
32 software or use pieces of it in new free programs; and that you know you can do
33 these things.
34
35 To protect your rights, we need to make restrictions that forbid anyone to deny
36 you these rights or to ask you to surrender the rights. These restrictions
37 translate to certain responsibilities for you if you distribute copies of the
38 software, or if you modify it.
39
40 For example, if you distribute copies of such a program, whether gratis or for a
41 fee, you must give the recipients all the rights that you have. You must make
42 sure that they, too, receive or can get the source code. And you must show
43 them these terms so they know their rights.
44
45 We protect your rights with two steps: (1) copyright the software, and (2) offer
46 you this license which gives you legal permission to copy, distribute and/or
47 modify the software.
48
49 Also, for each author's protection and ours, we want to make certain that
50 everyone understands that there is no warranty for this free software. If the
51 software is modified by someone else and passed on, we want its recipients to
52 know that what they have is not the original, so that any problems introduced by
53 others will not reflect on the original authors' reputations.
54
55 Finally, any free program is threatened constantly by software patents. We wish
56 to avoid the danger that redistributors of a free program will individually obtain
57 patent licenses, in effect making the program proprietary. To prevent this, we
58 have made it clear that any patent must be licensed for everyone's free use or
59 not licensed at all.
60
61 The precise terms and conditions for copying, distribution and modification
62 follow.
63
64 GNU GENERAL PUBLIC LICENSE
65 TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND
66 MODIFICATION
67
68 0. This License applies to any program or other work which contains a notice
69 placed by the copyright holder saying it may be distributed under the terms of
70 this General Public License. The "Program", below, refers to any such program
71 or work, and a "work based on the Program" means either the Program or any
72 derivative work under copyright law: that is to say, a work containing the
73 Program or a portion of it, either verbatim or with modifications and/or translated
74 into another language. (Hereinafter, translation is included without limitation in
75 the term "modification".) Each licensee is addressed as "you".
76
77 Activities other than copying, distribution and modification are not covered by
78 this License; they are outside its scope. The act of running the Program is not
79 restricted, and the output from the Program is covered only if its contents
80 constitute a work based on the Program (independent of having been made by
81 running the Program). Whether that is true depends on what the Program does.
82
83 1. You may copy and distribute verbatim copies of the Program's source code as
84 you receive it, in any medium, provided that you conspicuously and appropriately
85 publish on each copy an appropriate copyright notice and disclaimer of warranty;
86 keep intact all the notices that refer to this License and to the absence of any
87 warranty; and give any other recipients of the Program a copy of this License
8488 along with the Program.
8589
86 You may charge a fee for the physical act of transferring a copy, and
87 you may at your option offer warranty protection in exchange for a fee.
88
89 2. You may modify your copy or copies of the Program or any portion
90 of it, thus forming a work based on the Program, and copy and
91 distribute such modifications or work under the terms of Section 1
92 above, provided that you also meet all of these conditions:
93
94 a) You must cause the modified files to carry prominent notices
95 stating that you changed the files and the date of any change.
96
97 b) You must cause any work that you distribute or publish, that in
98 whole or in part contains or is derived from the Program or any
99 part thereof, to be licensed as a whole at no charge to all third
100 parties under the terms of this License.
101
102 c) If the modified program normally reads commands interactively
103 when run, you must cause it, when started running for such
104 interactive use in the most ordinary way, to print or display an
105 announcement including an appropriate copyright notice and a
106 notice that there is no warranty (or else, saying that you provide
107 a warranty) and that users may redistribute the program under
108 these conditions, and telling the user how to view a copy of this
109 License. (Exception: if the Program itself is interactive but
110 does not normally print such an announcement, your work based on
111 the Program is not required to print an announcement.)
112
113 These requirements apply to the modified work as a whole. If
114 identifiable sections of that work are not derived from the Program,
115 and can be reasonably considered independent and separate works in
116 themselves, then this License, and its terms, do not apply to those
117 sections when you distribute them as separate works. But when you
118 distribute the same sections as part of a whole which is a work based
119 on the Program, the distribution of the whole must be on the terms of
120 this License, whose permissions for other licensees extend to the
90 You may charge a fee for the physical act of transferring a copy, and you may at
91 your option offer warranty protection in exchange for a fee.
92
93 2. You may modify your copy or copies of the Program or any portion of it, thus
94 forming a work based on the Program, and copy and distribute such
95 modifications or work under the terms of Section 1 above, provided that you also
96 meet all of these conditions:
97
98 a) You must cause the modified files to carry prominent notices stating that you
99 changed the files and the date of any change.
100
101 b) You must cause any work that you distribute or publish, that in whole or in
102 part contains or is derived from the Program or any part thereof, to be licensed
103 as a whole at no charge to all third parties under the terms of this License.
104
105 c) If the modified program normally reads commands interactively when run, you
106 must cause it, when started running for such interactive use in the most ordinary
107 way, to print or display an announcement including an appropriate copyright
108 notice and a notice that there is no warranty (or else, saying that you provide a
109 warranty) and that users may redistribute the program under these conditions,
110 and telling the user how to view a copy of this License. (Exception: if the
111 Program itself is interactive but does not normally print such an announcement,
112 your work based on the Program is not required to print an announcement.)
113
114 These requirements apply to the modified work as a whole. If identifiable
115 sections of that work are not derived from the Program, and can be reasonably
116 considered independent and separate works in themselves, then this License,
117 and its terms, do not apply to those sections when you distribute them as
118 separate works. But when you distribute the same sections as part of a whole
119 which is a work based on the Program, the distribution of the whole must be on
120 the terms of this License, whose permissions for other licensees extend to the
121121 entire whole, and thus to each and every part regardless of who wrote it.
122122
123 Thus, it is not the intent of this section to claim rights or contest
124 your rights to work written entirely by you; rather, the intent is to
125 exercise the right to control the distribution of derivative or
126 collective works based on the Program.
127
128 In addition, mere aggregation of another work not based on the Program
129 with the Program (or with a work based on the Program) on a volume of
130 a storage or distribution medium does not bring the other work under
131 the scope of this License.
132
133 3. You may copy and distribute the Program (or a work based on it,
134 under Section 2) in object code or executable form under the terms of
135 Sections 1 and 2 above provided that you also do one of the following:
136
137 a) Accompany it with the complete corresponding machine-readable
138 source code, which must be distributed under the terms of Sections
139 1 and 2 above on a medium customarily used for software interchange; or,
140
141 b) Accompany it with a written offer, valid for at least three
142 years, to give any third party, for a charge no more than your
143 cost of physically performing source distribution, a complete
144 machine-readable copy of the corresponding source code, to be
145 distributed under the terms of Sections 1 and 2 above on a medium
146 customarily used for software interchange; or,
147
148 c) Accompany it with the information you received as to the offer
149 to distribute corresponding source code. (This alternative is
150 allowed only for noncommercial distribution and only if you
151 received the program in object code or executable form with such
152 an offer, in accord with Subsection b above.)
153
154 The source code for a work means the preferred form of the work for
155 making modifications to it. For an executable work, complete source
156 code means all the source code for all modules it contains, plus any
157 associated interface definition files, plus the scripts used to
158 control compilation and installation of the executable. However, as a
159 special exception, the source code distributed need not include
160 anything that is normally distributed (in either source or binary
161 form) with the major components (compiler, kernel, and so on) of the
162 operating system on which the executable runs, unless that component
163 itself accompanies the executable.
164
165 If distribution of executable or object code is made by offering
166 access to copy from a designated place, then offering equivalent
167 access to copy the source code from the same place counts as
168 distribution of the source code, even though third parties are not
169 compelled to copy the source along with the object code.
170
171 4. You may not copy, modify, sublicense, or distribute the Program
172 except as expressly provided under this License. Any attempt
173 otherwise to copy, modify, sublicense or distribute the Program is
174 void, and will automatically terminate your rights under this License.
175 However, parties who have received copies, or rights, from you under
176 this License will not have their licenses terminated so long as such
177 parties remain in full compliance.
178
179 5. You are not required to accept this License, since you have not
180 signed it. However, nothing else grants you permission to modify or
181 distribute the Program or its derivative works. These actions are
182 prohibited by law if you do not accept this License. Therefore, by
183 modifying or distributing the Program (or any work based on the
184 Program), you indicate your acceptance of this License to do so, and
185 all its terms and conditions for copying, distributing or modifying
186 the Program or works based on it.
187
188 6. Each time you redistribute the Program (or any work based on the
189 Program), the recipient automatically receives a license from the
190 original licensor to copy, distribute or modify the Program subject to
191 these terms and conditions. You may not impose any further
192 restrictions on the recipients' exercise of the rights granted herein.
193 You are not responsible for enforcing compliance by third parties to
194 this License.
195
196 7. If, as a consequence of a court judgment or allegation of patent
197 infringement or for any other reason (not limited to patent issues),
198 conditions are imposed on you (whether by court order, agreement or
199 otherwise) that contradict the conditions of this License, they do not
200 excuse you from the conditions of this License. If you cannot
201 distribute so as to satisfy simultaneously your obligations under this
202 License and any other pertinent obligations, then as a consequence you
203 may not distribute the Program at all. For example, if a patent
204 license would not permit royalty-free redistribution of the Program by
205 all those who receive copies directly or indirectly through you, then
206 the only way you could satisfy both it and this License would be to
207 refrain entirely from distribution of the Program.
208
209 If any portion of this section is held invalid or unenforceable under
210 any particular circumstance, the balance of the section is intended to
211 apply and the section as a whole is intended to apply in other
212 circumstances.
213
214 It is not the purpose of this section to induce you to infringe any
215 patents or other property right claims or to contest validity of any
216 such claims; this section has the sole purpose of protecting the
217 integrity of the free software distribution system, which is
218 implemented by public license practices. Many people have made
219 generous contributions to the wide range of software distributed
220 through that system in reliance on consistent application of that
221 system; it is up to the author/donor to decide if he or she is willing
222 to distribute software through any other system and a licensee cannot
223 impose that choice.
224
225 This section is intended to make thoroughly clear what is believed to
226 be a consequence of the rest of this License.
227
228 8. If the distribution and/or use of the Program is restricted in
229 certain countries either by patents or by copyrighted interfaces, the
230 original copyright holder who places the Program under this License
231 may add an explicit geographical distribution limitation excluding
232 those countries, so that distribution is permitted only in or among
233 countries not thus excluded. In such case, this License incorporates
234 the limitation as if written in the body of this License.
235
236 9. The Free Software Foundation may publish revised and/or new versions
237 of the General Public License from time to time. Such new versions will
238 be similar in spirit to the present version, but may differ in detail to
239 address new problems or concerns.
240
241 Each version is given a distinguishing version number. If the Program
242 specifies a version number of this License which applies to it and "any
243 later version", you have the option of following the terms and conditions
244 either of that version or of any later version published by the Free
245 Software Foundation. If the Program does not specify a version number of
246 this License, you may choose any version ever published by the Free Software
247 Foundation.
248
249 10. If you wish to incorporate parts of the Program into other free
250 programs whose distribution conditions are different, write to the author
251 to ask for permission. For software which is copyrighted by the Free
252 Software Foundation, write to the Free Software Foundation; we sometimes
253 make exceptions for this. Our decision will be guided by the two goals
254 of preserving the free status of all derivatives of our free software and
255 of promoting the sharing and reuse of software generally.
256
257 NO WARRANTY
258
259 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
260 FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
261 OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
262 PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
263 OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
264 MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
265 TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
266 PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
267 REPAIR OR CORRECTION.
268
269 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
270 WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
271 REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
272 INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
273 OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
274 TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
275 YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
276 PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
277 POSSIBILITY OF SUCH DAMAGES.
278
279 END OF TERMS AND CONDITIONS
280
281 Appendix: How to Apply These Terms to Your New Programs
282
283 If you develop a new program, and you want it to be of the greatest
284 possible use to the public, the best way to achieve this is to make it
285 free software which everyone can redistribute and change under these terms.
286
287 To do so, attach the following notices to the program. It is safest
288 to attach them to the start of each source file to most effectively
289 convey the exclusion of warranty; and each file should have at least
290 the "copyright" line and a pointer to where the full notice is found.
291
292 <one line to give the program's name and a brief idea of what it does.>
293 Copyright (C) 19yy <name of author>
294
295 This program is free software; you can redistribute it and/or modify
296 it under the terms of the GNU General Public License as published by
297 the Free Software Foundation; either version 2 of the License, or
298 (at your option) any later version.
299
300 This program is distributed in the hope that it will be useful,
301 but WITHOUT ANY WARRANTY; without even the implied warranty of
302 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
303 GNU General Public License for more details.
304
305 You should have received a copy of the GNU General Public License
306 along with this program; if not, write to the Free Software
307 Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
308
309 Also add information on how to contact you by electronic and paper mail.
310
311 If the program is interactive, make it output a short notice like this
312 when it starts in an interactive mode:
313
314 Gnomovision version 69, Copyright (C) 19yy name of author
315 Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
316 This is free software, and you are welcome to redistribute it
317 under certain conditions; type `show c' for details.
318
319 The hypothetical commands `show w' and `show c' should show the appropriate
320 parts of the General Public License. Of course, the commands you use may
321 be called something other than `show w' and `show c'; they could even be
322 mouse-clicks or menu items--whatever suits your program.
323
324 You should also get your employer (if you work as a programmer) or your
325 school, if any, to sign a "copyright disclaimer" for the program, if
326 necessary. Here is a sample; alter the names:
327
328 Yoyodyne, Inc., hereby disclaims all copyright interest in the program
329 `Gnomovision' (which makes passes at compilers) written by James Hacker.
330
331 <signature of Ty Coon>, 1 April 1989
332 Ty Coon, President of Vice
333
334 This General Public License does not permit incorporating your program into
335 proprietary programs. If your program is a subroutine library, you may
336 consider it more useful to permit linking proprietary applications with the
337 library. If this is what you want to do, use the GNU Library General
338 Public License instead of this License.
123 Thus, it is not the intent of this section to claim rights or contest your rights to
124 work written entirely by you; rather, the intent is to exercise the right to control
125 the distribution of derivative or collective works based on the Program.
126
127 In addition, mere aggregation of another work not based on the Program with the
128 Program (or with a work based on the Program) on a volume of a storage or
129 distribution medium does not bring the other work under the scope of this
130 License.
131
132 3. You may copy and distribute the Program (or a work based on it, under
133 Section 2) in object code or executable form under the terms of Sections 1 and 2
134 above provided that you also do one of the following:
135
136 a) Accompany it with the complete corresponding machine-readable source
137 code, which must be distributed under the terms of Sections 1 and 2 above on a
138 medium customarily used for software interchange; or,
139
140 b) Accompany it with a written offer, valid for at least three years, to give any
141 third party, for a charge no more than your cost of physically performing source
142 distribution, a complete machine-readable copy of the corresponding source
143 code, to be distributed under the terms of Sections 1 and 2 above on a medium
144 customarily used for software interchange; or,
145
146 c) Accompany it with the information you received as to the offer to distribute
147 corresponding source code. (This alternative is allowed only for noncommercial
148 distribution and only if you received the program in object code or executable
149 form with such an offer, in accord with Subsection b above.)
150
151 The source code for a work means the preferred form of the work for making
152 modifications to it. For an executable work, complete source code means all the
153 source code for all modules it contains, plus any associated interface definition
154 files, plus the scripts used to control compilation and installation of the
155 executable. However, as a special exception, the source code distributed need
156 not include anything that is normally distributed (in either source or binary form)
157 with the major components (compiler, kernel, and so on) of the operating system
158 on which the executable runs, unless that component itself accompanies the
159 executable.
160
161 If distribution of executable or object code is made by offering access to copy
162 from a designated place, then offering equivalent access to copy the source
163 code from the same place counts as distribution of the source code, even though
164 third parties are not compelled to copy the source along with the object code.
165
166 4. You may not copy, modify, sublicense, or distribute the Program except as
167 expressly provided under this License. Any attempt otherwise to copy, modify,
168 sublicense or distribute the Program is void, and will automatically terminate
169 your rights under this License. However, parties who have received copies, or
170 rights, from you under this License will not have their licenses terminated so long
171 as such parties remain in full compliance.
172
173 5. You are not required to accept this License, since you have not signed it.
174 However, nothing else grants you permission to modify or distribute the Program
175 or its derivative works. These actions are prohibited by law if you do not accept
176 this License. Therefore, by modifying or distributing the Program (or any work
177 based on the Program), you indicate your acceptance of this License to do so,
178 and all its terms and conditions for copying, distributing or modifying the
179 Program or works based on it.
180
181 6. Each time you redistribute the Program (or any work based on the Program),
182 the recipient automatically receives a license from the original licensor to copy,
183 distribute or modify the Program subject to these terms and conditions. You
184 may not impose any further restrictions on the recipients' exercise of the rights
185 granted herein. You are not responsible for enforcing compliance by third parties
186 to this License.
187
188 7. If, as a consequence of a court judgment or allegation of patent infringement
189 or for any other reason (not limited to patent issues), conditions are imposed on
190 you (whether by court order, agreement or otherwise) that contradict the
191 conditions of this License, they do not excuse you from the conditions of this
192 License. If you cannot distribute so as to satisfy simultaneously your obligations
193 under this License and any other pertinent obligations, then as a consequence
194 you may not distribute the Program at all. For example, if a patent license would
195 not permit royalty-free redistribution of the Program by all those who receive
196 copies directly or indirectly through you, then the only way you could satisfy
197 both it and this License would be to refrain entirely from distribution of the
198 Program.
199
200 If any portion of this section is held invalid or unenforceable under any particular
201 circumstance, the balance of the section is intended to apply and the section as
202 a whole is intended to apply in other circumstances.
203
204 It is not the purpose of this section to induce you to infringe any patents or other
205 property right claims or to contest validity of any such claims; this section has
206 the sole purpose of protecting the integrity of the free software distribution
207 system, which is implemented by public license practices. Many people have
208 made generous contributions to the wide range of software distributed through
209 that system in reliance on consistent application of that system; it is up to the
210 author/donor to decide if he or she is willing to distribute software through any
211 other system and a licensee cannot impose that choice.
212
213 This section is intended to make thoroughly clear what is believed to be a
214 consequence of the rest of this License.
215
216 8. If the distribution and/or use of the Program is restricted in certain countries
217 either by patents or by copyrighted interfaces, the original copyright holder who
218 places the Program under this License may add an explicit geographical
219 distribution limitation excluding those countries, so that distribution is permitted
220 only in or among countries not thus excluded. In such case, this License
221 incorporates the limitation as if written in the body of this License.
222
223 9. The Free Software Foundation may publish revised and/or new versions of the
224 General Public License from time to time. Such new versions will be similar in
225 spirit to the present version, but may differ in detail to address new problems or
226 concerns.
227
228 Each version is given a distinguishing version number. If the Program specifies a
229 version number of this License which applies to it and "any later version", you
230 have the option of following the terms and conditions either of that version or of
231 any later version published by the Free Software Foundation. If the Program does
232 not specify a version number of this License, you may choose any version ever
233 published by the Free Software Foundation.
234
235 10. If you wish to incorporate parts of the Program into other free programs
236 whose distribution conditions are different, write to the author to ask for
237 permission. For software which is copyrighted by the Free Software Foundation,
238 write to the Free Software Foundation; we sometimes make exceptions for this.
239 Our decision will be guided by the two goals of preserving the free status of all
240 derivatives of our free software and of promoting the sharing and reuse of
241 software generally.
242
243 NO WARRANTY
244
245 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS
246 NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
247 APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE
248 COPYRIGHT HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM
249 "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED OR
250 IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
251 MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE
252 ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE
253 PROGRAM IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE,
254 YOU ASSUME THE COST OF ALL NECESSARY SERVICING, REPAIR OR
255 CORRECTION.
256
257 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED
258 TO IN WRITING WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY
259 WHO MAY MODIFY AND/OR REDISTRIBUTE THE PROGRAM AS
260 PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
261 GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES
262 ARISING OUT OF THE USE OR INABILITY TO USE THE PROGRAM
263 (INCLUDING BUT NOT LIMITED TO LOSS OF DATA OR DATA BEING
264 RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
265 PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY
266 OTHER PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS
267 BEEN ADVISED OF THE POSSIBILITY OF SUCH DAMAGES.
268
269 END OF TERMS AND CONDITIONS
270
271
272 ----------------------------------------------------------------------------
273
274 The Artistic License
275
276 Preamble
277
278 The intent of this document is to state the conditions under which a Package
279 may be copied, such that the Copyright Holder maintains some semblance of
280 artistic control over the development of the package, while giving the users of the
281 package the right to use and distribute the Package in a more-or-less customary
282 fashion, plus the right to make reasonable modifications.
283
284 Definitions:
285
286 - "Package" refers to the collection of files distributed by the Copyright
287 Holder, and derivatives of that collection of files created through textual
288 modification.
289 - "Standard Version" refers to such a Package if it has not been modified,
290 or has been modified in accordance with the wishes of the Copyright
291 Holder.
292 - "Copyright Holder" is whoever is named in the copyright or copyrights for
293 the package.
294 - "You" is you, if you're thinking about copying or distributing this Package.
295 - "Reasonable copying fee" is whatever you can justify on the basis of
296 media cost, duplication charges, time of people involved, and so on. (You
297 will not be required to justify it to the Copyright Holder, but only to the
298 computing community at large as a market that must bear the fee.)
299 - "Freely Available" means that no fee is charged for the item itself, though
300 there may be fees involved in handling the item. It also means that
301 recipients of the item may redistribute it under the same conditions they
302 received it.
303
304 1. You may make and give away verbatim copies of the source form of the
305 Standard Version of this Package without restriction, provided that you duplicate
306 all of the original copyright notices and associated disclaimers.
307
308 2. You may apply bug fixes, portability fixes and other modifications derived from
309 the Public Domain or from the Copyright Holder. A Package modified in such a
310 way shall still be considered the Standard Version.
311
312 3. You may otherwise modify your copy of this Package in any way, provided
313 that you insert a prominent notice in each changed file stating how and when
314 you changed that file, and provided that you do at least ONE of the following:
315
316 a) place your modifications in the Public Domain or otherwise
317 make them Freely Available, such as by posting said modifications
318 to Usenet or an equivalent medium, or placing the modifications on
319 a major archive site such as ftp.uu.net, or by allowing the
320 Copyright Holder to include your modifications in the Standard
321 Version of the Package.
322
323 b) use the modified Package only within your corporation or
324 organization.
325
326 c) rename any non-standard executables so the names do not
327 conflict with standard executables, which must also be provided,
328 and provide a separate manual page for each non-standard
329 executable that clearly documents how it differs from the Standard
330 Version.
331
332 d) make other distribution arrangements with the Copyright Holder.
333
334 4. You may distribute the programs of this Package in object code or executable
335 form, provided that you do at least ONE of the following:
336
337 a) distribute a Standard Version of the executables and library
338 files, together with instructions (in the manual page or equivalent)
339 on where to get the Standard Version.
340
341 b) accompany the distribution with the machine-readable source of
342 the Package with your modifications.
343
344 c) accompany any non-standard executables with their
345 corresponding Standard Version executables, giving the
346 non-standard executables non-standard names, and clearly
347 documenting the differences in manual pages (or equivalent),
348 together with instructions on where to get the Standard Version.
349
350 d) make other distribution arrangements with the Copyright Holder.
351
352 5. You may charge a reasonable copying fee for any distribution of this Package.
353 You may charge any fee you choose for support of this Package. You may not
354 charge a fee for this Package itself. However, you may distribute this Package in
355 aggregate with other (possibly commercial) programs as part of a larger
356 (possibly commercial) software distribution provided that you do not advertise
357 this Package as a product of your own.
358
359 6. The scripts and library files supplied as input to or produced as output from
360 the programs of this Package do not automatically fall under the copyright of this
361 Package, but belong to whomever generated them, and may be sold
362 commercially, and may be aggregated with this Package.
363
364 7. C or perl subroutines supplied by you and linked into this Package shall not
365 be considered part of this Package.
366
367 8. The name of the Copyright Holder may not be used to endorse or promote
368 products derived from this software without specific prior written permission.
369
370 9. THIS PACKAGE IS PROVIDED "AS IS" AND WITHOUT ANY EXPRESS OR
371 IMPLIED WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED
372 WARRANTIES OF MERCHANTIBILITY AND FITNESS FOR A PARTICULAR
373 PURPOSE.
374
375 The End
376
377
+46
-24
MANIFEST less more
00 Makefile.PL
1 INSTALL
2 MANIFEST
3 LICENSE
4 CHANGELOG
5 README
16 lib/Parse/PlainConfig.pm
2 CHANGELOG
3 CREDITS
4 README
5 LICENSE
6 MANIFEST
7 t/01_ini.t
8 t/02_property.t
9 t/03_read.t
10 t/04_parameters.t
11 t/05_purge.t
12 t/06_scalar.t
13 t/07_list.t
14 t/08_hash.t
15 t/09_coerce.t
16 t/10_write.t
17 t/11_order.t
18 t/12_purge.t
19 t/13_readIfNewer.t
20 t/14_compat.t
21 t/15_defaults.t
22 t/16_hasParameter.t
23 t/testrc
24 t/testrc_smart
25 META.yml Module meta-data (added by MakeMaker)
7 lib/Parse/PlainConfig/Constants.pm
8 lib/Parse/PlainConfig/Legacy.pm
9 lib/Parse/PlainConfig/Settings.pm
10 t/98_pod_coverage.t
11 t/99_pod.t
12 t/lib/01_include_me.conf
13 t/lib/BadConf.pm
14 t/lib/CStyle.pm
15 t/lib/MyConf.pm
16 t/lib/NoDefaults.pm
17 t/lib/mac.conf
18 t/lib/msdos.conf
19 t/lib/unix.conf
20 t/v2_01_ini.t
21 t/v2_02_property.t
22 t/v2_03_read.t
23 t/v2_04_parameters.t
24 t/v2_05_purge.t
25 t/v2_06_scalar.t
26 t/v2_07_list.t
27 t/v2_08_hash.t
28 t/v2_09_coerce.t
29 t/v2_10_write.t
30 t/v2_11_order.t
31 t/v2_12_purge.t
32 t/v2_13_readIfNewer.t
33 t/v2_15_defaults.t
34 t/v2_16_hasParameter.t
35 t/v2_testrc
36 t/v2_testrc_smart
37 t/v3_01_constants.t
38 t/v3_02_init.t
39 t/v3_03_parameters.t
40 t/v3_04_bad_conf.t
41 t/v3_05_no_defaults.t
42 t/v3_06_c_style.t
43 t/v3_07_unix.t
44 t/v3_08_msdos.t
45 t/v3_09_mac.t
46 META.yml Module YAML meta-data (added by MakeMaker)
47 META.json Module JSON meta-data (added by MakeMaker)
+45
-0
META.json less more
0 {
1 "abstract" : "Parser/Generator of human-readable conf files",
2 "author" : [
3 "Arthur Corliss <corliss@digitalmages.com>"
4 ],
5 "dynamic_config" : 1,
6 "generated_by" : "ExtUtils::MakeMaker version 6.86, CPAN::Meta::Converter version 2.120351",
7 "license" : [
8 "perl_5"
9 ],
10 "meta-spec" : {
11 "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
12 "version" : "2"
13 },
14 "name" : "Parse-PlainConfig",
15 "no_index" : {
16 "directory" : [
17 "t",
18 "inc"
19 ]
20 },
21 "prereqs" : {
22 "build" : {
23 "requires" : {
24 "ExtUtils::MakeMaker" : "0"
25 }
26 },
27 "configure" : {
28 "requires" : {
29 "ExtUtils::MakeMaker" : "0"
30 }
31 },
32 "runtime" : {
33 "requires" : {
34 "Class::EHierarchy" : "0.93",
35 "Paranoid" : "2",
36 "Text::ParseWords" : "0",
37 "Text::Tabs" : "0",
38 "perl" : "5.008003"
39 }
40 }
41 },
42 "release_status" : "stable",
43 "version" : "3.02"
44 }
+25
-15
META.yml less more
0 --- #YAML:1.0
1 name: Parse-PlainConfig
2 version: 2.06
3 abstract: Parser/Generator of human-readable conf files
4 license: ~
5 generated_by: ExtUtils::MakeMaker version 6.36
6 distribution_type: module
7 requires:
8 Paranoid:
9 Text::ParseWords:
10 Text::Tabs:
0 ---
1 abstract: 'Parser/Generator of human-readable conf files'
2 author:
3 - 'Arthur Corliss <corliss@digitalmages.com>'
4 build_requires:
5 ExtUtils::MakeMaker: 0
6 configure_requires:
7 ExtUtils::MakeMaker: 0
8 dynamic_config: 1
9 generated_by: 'ExtUtils::MakeMaker version 6.86, CPAN::Meta::Converter version 2.120351'
10 license: perl
1111 meta-spec:
12 url: http://module-build.sourceforge.net/META-spec-v1.2.html
13 version: 1.2
14 author:
15 - Arthur Corliss <corliss@digitalmages.com>
12 url: http://module-build.sourceforge.net/META-spec-v1.4.html
13 version: 1.4
14 name: Parse-PlainConfig
15 no_index:
16 directory:
17 - t
18 - inc
19 requires:
20 Class::EHierarchy: 0.93
21 Paranoid: 2
22 Text::ParseWords: 0
23 Text::Tabs: 0
24 perl: 5.008003
25 version: 3.02
+21
-10
Makefile.PL less more
00 use ExtUtils::MakeMaker;
1 use 5.008003;
12
3 # Create the makefile
24 WriteMakefile(
3 NAME => 'Parse::PlainConfig',
4 AUTHOR => 'Arthur Corliss <corliss@digitalmages.com>',
5 ABSTRACT => 'Parser/Generator of human-readable conf files',
6 VERSION_FROM => 'lib/Parse/PlainConfig.pm',
7 PREREQ_PM => {
8 Paranoid => undef,
9 Text::ParseWords => undef,
10 Text::Tabs => undef,
11 },
12 );
5 NAME => 'Parse::PlainConfig',
6 ABSTRACT => 'Parser/Generator of human-readable conf files',
7 AUTHOR => 'Arthur Corliss <corliss@digitalmages.com>',
8 VERSION_FROM => 'lib/Parse/PlainConfig.pm',
9 PREREQ_PM => {
10 'Class::EHierarchy' => 0.93,
11 'Paranoid' => 2.00,
12 'Text::ParseWords' => 0,
13 'Text::Tabs' => 0,
14 }, (
15 $ExtUtils::MakeMaker::VERSION ge '6.30_00' ? ( LICENSE => 'perl', )
16 : ()
17 ), (
18 $ExtUtils::MakeMaker::VERSION ge '6.48'
19 ? ( MIN_PERL_VERSION => 5.008003 )
20 : ()
21 ),
22 );
1323
1424 exit 0;
25
+19
-17
README less more
00 Parse::PlainConfig
11 ==================
22
3 Author: Arthur Corliss
4 Date: May 26, 2006
3 NOTICE: We've jumped a major rev due to a break in the API. After ten
4 years of using Parse::PlainConfig it was inevitable that I would arrive to
5 the conclusion that while the features was nice it was simply a major PITA
6 from a developer's perspective.
57
6 Description:
7 ------------
8 For that reason this module has been rewritten entirely from scratch with
9 the aim to make it trivial to implement as a developer. I find the new
10 subclassing method to be rather insanely easy, actually, and includes some
11 new features.
812
9 This is a long overdue complete rewrite. It has a lot of feature improvements
10 along with much cleaner and robust coding.
13 The trade off for that, however, was dropping the config generator,
14 something that sounded good at the time, but something I never actually
15 used. My wager is that no one else did, either.
1116
12 Instructions:
13 -------------
17 Legacy Support
18 --------------
1419
15 Like all CPAN modules, just enter the following commands:
20 For your convenience I've left the old module in this distribution, albeit
21 under new namespace. My hope is that this will require minimal adjustments
22 to any existing scripts that rely on it. I truly believe, though, you will
23 find the new version so much more pleasureable to use that you'll migrate to
24 that, instead.
1625
17 $ perl Makefile.PL
18 $ make
19 $ make test
20 $ make install
26 The old module is now called Parse::PlainConfig::Legacy.
2127
22 If you wish to see sample code using the module, please examine test files in
23 the t directory. A sample rc file is there as well, which shows the
24 robustness of the parser.
25
+166
-0
lib/Parse/PlainConfig/Constants.pm less more
0 # Prase::PlainConfig::Constants -- PPC Constants
1 #
2 # (c) 2012, Arthur Corliss <corliss@digitalmages.com>
3 #
4 # $Id: lib/Parse/PlainConfig/Constants.pm, 3.02 2016/05/26 13:04:45 acorliss Exp $
5 #
6 # This software is licensed under the same terms as Perl, itself.
7 # Please see http://dev.perl.org/licenses/ for more information.
8 #
9 #####################################################################
10
11 #####################################################################
12 #
13 # Environment definitions
14 #
15 #####################################################################
16
17 package Parse::PlainConfig::Constants;
18
19 use 5.008;
20
21 use strict;
22 use warnings;
23 use vars qw($VERSION @EXPORT @EXPORT_OK %EXPORT_TAGS);
24 use Exporter;
25 use Class::EHierarchy qw(:all);
26
27 use base qw(Exporter);
28
29 ($VERSION) = ( q$Revision: 3.02 $ =~ /(\d+(?:\.(\d+))+)/sm );
30
31 use constant PPCDLEVEL1 => 7;
32 use constant PPCDLEVEL2 => 8;
33 use constant PPCDLEVEL3 => 9;
34 use constant PPC_DEF_SIZE => 65_536;
35
36 use constant MTIME => 9;
37
38 use constant DEFAULT_PDLM => ':';
39 use constant DEFAULT_LDLM => ',';
40 use constant DEFAULT_HDLM => '=>';
41 use constant DEFAULT_CMMT => '#';
42 use constant DEFAULT_SUBI => 8;
43 use constant DEFAULT_TAB => 8;
44 use constant DEFAULT_TW => 78;
45 use constant DEFAULT_HDOC => 'EOF';
46
47 use constant PPC_SCALAR => CEH_SCALAR;
48 use constant PPC_ARRAY => CEH_ARRAY;
49 use constant PPC_HASH => CEH_HASH;
50 use constant PPC_HDOC => 512;
51
52 @EXPORT = qw(PPC_SCALAR PPC_ARRAY PPC_HASH PPC_HDOC);
53 @EXPORT_OK = (
54 @EXPORT, qw(PPCDLEVEL1 PPCDLEVEL2 PPCDLEVEL3 PPC_DEF_SIZE
55 MTIME DEFAULT_TW DEFAULT_PDLM DEFAULT_LDLM DEFAULT_HDLM
56 DEFAULT_CMMT DEFAULT_SUBI DEFAULT_TAB DEFAULT_HDOC)
57 );
58 %EXPORT_TAGS = (
59 all => [@EXPORT_OK],
60 std => [@EXPORT],
61 debug => [qw(PPCDLEVEL1 PPCDLEVEL2 PPCDLEVEL3)],
62 );
63
64 #####################################################################
65 #
66 # Module code follows
67 #
68 #####################################################################
69
70 1;
71
72 __END__
73
74 =head1 NAME
75
76 Parse::PlainConfig::Constants - PPC Constants
77
78 =head1 VERSION
79
80 $Id: lib/Parse/PlainConfig/Constants.pm, 3.02 2016/05/26 13:04:45 acorliss Exp $
81
82 =head1 SYNOPSIS
83
84 use Parse::PlainConfig::Constants;
85
86 $scalarType = PPC_SCALAR;
87 $arrayType = PPC_ARRAY;
88 $hashType = PPC_HASH;
89 $hdocType = PPC_HDOC;
90
91 =head1 DESCRIPTION
92
93 This module provides a number of constants that are used mostly internally.
94 That said, the default export provides the basic data types you'll need to
95 declare your parameter types.
96
97 You can also export debug level constants to provide trace information out to
98 B<STDERR>.
99
100 =head1 SUBROUTINES/METHODS
101
102 None.
103
104 =head1 CONSTANTS
105
106 THere are three export sets provided by this module:
107
108 Set Description
109 ----------------------------------------------------
110 std Parameter data type constants
111 debug Debug level constants
112 all All constants (including internall constants
113
114 =head2 std
115
116 =head3 PPC_SCALAR
117
118 Scalar data type. Leading and trailing white space is trimmed.
119
120 =head3 PPC_ARRAY
121
122 Array data type. Leading and trailing white space for all elements is trimmed.
123
124 =head3 PPC_HASH
125
126 Hash data type. Leading and trailing white space for all keys and values is
127 trimmed.
128
129 =head3 PPC_HDOC
130
131 Here doc data type. Functionally equivalent to L<PPC_SCALAR>.
132
133 =head2 debug
134
135 The higher the debug level the more verbose the output.
136
137 =head3 PPCDLEVEL1
138
139 =head3 PPCDLEVEL2
140
141 =head3 PPCDLEVEL3
142
143 =head2 all
144
145 =head1 DEPENDENCIES
146
147 =over
148
149 =item o Exporter
150
151 =back
152
153 =head1 BUGS AND LIMITATIONS
154
155 =head1 AUTHOR
156
157 Arthur Corliss (corliss@digitalmages.com)
158
159 =head1 LICENSE AND COPYRIGHT
160
161 This software is licensed under the same terms as Perl, itself.
162 Please see http://dev.perl.org/licenses/ for more information.
163
164 (c) 2016, Arthur Corliss (corliss@digitalmages.com)
165
+1583
-0
lib/Parse/PlainConfig/Legacy.pm less more
0 # Parse::PlainConfig::Legacy -- Parsing Engine Legacy for Parse::PlainConfig
1 #
2 # (c) 2002 - 2016, Arthur Corliss <corliss@digitalmages.com>,
3 #
4 # $Id: lib/Parse/PlainConfig/Legacy.pm, 3.02 2016/05/26 13:04:45 acorliss Exp $
5 #
6 # This software is licensed under the same terms as Perl, itself.
7 # Please see http://dev.perl.org/licenses/ for more information.
8 #
9 #####################################################################
10
11 #####################################################################
12 #
13 # Environment definitions
14 #
15 #####################################################################
16
17 package Parse::PlainConfig::Legacy;
18
19 use 5.006;
20
21 use strict;
22 use warnings;
23 use vars qw($VERSION);
24
25 ($VERSION) = ( q$Revision: 3.02 $ =~ /(\d+(?:\.(\d+))+)/sm );
26
27 use Parse::PlainConfig::Constants qw(:all);
28 use Text::ParseWords;
29 use Text::Tabs;
30 use Carp;
31 use Fcntl qw(:flock);
32 use Paranoid;
33 use Paranoid::Data;
34 use Paranoid::Debug;
35 use Paranoid::Filesystem;
36 use Paranoid::Input;
37 use Paranoid::IO qw(:all);
38 use Paranoid::IO::Line;
39
40 #####################################################################
41 #
42 # Module code follows
43 #
44 #####################################################################
45
46 {
47 my $ERROR = '';
48
49 sub ERROR : lvalue {
50 $ERROR;
51 }
52 }
53
54 sub new {
55
56 # Purpose: Creates a new object
57 # Returns: Object reference if successful, undef if not
58 # Usage: $obj = Parse::PlainConfig->new(%PARAMS);
59
60 my $class = shift;
61 my $self = {
62 CONF => {},
63 ORDER => [],
64 FILE => undef,
65 PARAM_DELIM => ':',
66 LIST_DELIM => ',',
67 HASH_DELIM => '=>',
68 AUTOPURGE => 0,
69 COERCE => {},
70 DEFAULTS => {},
71 SMART_PARSER => 0,
72 PADDING => 2,
73 MAX_BYTES => PPC_DEF_SIZE,
74 MTIME => 0,
75 };
76 my %args = @_;
77 my ( $k, $v, $rv );
78
79 pdebug( 'entering', PPCDLEVEL1 );
80 pIn();
81
82 bless $self, $class;
83
84 # Assign all the arguments
85 $rv = 1;
86 while ( $rv && scalar keys %args ) {
87 $k = shift @{ [ keys %args ] };
88 $v = $args{$k};
89 delete $args{$k};
90 $rv = 0 unless $self->property( $k, $v );
91 }
92
93 $self = undef unless $rv;
94
95 pOut();
96 pdebug( 'leaving w/rv: %s', PPCDLEVEL1, $self );
97
98 return $self;
99 }
100
101 sub property {
102
103 # Purpose: Gets/sets object property value
104 # Returns: Value of property in Get mode, true/false in set mode
105 # Usage: $value = $obj->property($name);
106 # Usage: $rv = $obj->property($name, $value);
107
108 my $self = shift;
109 my @args = @_;
110 my $arg = $_[0];
111 my $val = $_[1];
112 my $ival = defined $val ? $val : 'undef';
113 my $rv = 1;
114 my ( $k, $v );
115
116 croak 'Mandatory first argument must be a valid property name'
117 unless defined $arg and exists $$self{$arg};
118
119 pdebug( 'entering w/(%s)(%s)', PPCDLEVEL1, $arg, $ival );
120 pIn();
121
122 pdebug( 'method is in ' . ( scalar @args == 2 ? 'set' : 'get' ) . ' mode',
123 PPCDLEVEL1 );
124 $arg = uc $arg;
125
126 # Validate arguments & value
127 if ( scalar @args == 2 ) {
128
129 if ( $arg eq 'ORDER' ) {
130
131 # ORDER must be a list reference
132 unless ( ref $val eq 'ARRAY' ) {
133 $rv = 0;
134 Parse::PlainConfig::Legacy::ERROR =
135 pdebug( '%s\'s value must be a list reference',
136 PPCDLEVEL1, $arg );
137 }
138
139 } elsif ( $arg eq 'CONF' or $arg eq 'COERCE' or $arg eq 'DEFAULTS' ) {
140
141 # CONF, COERCE, and DEFAULTS must be a hash reference
142 unless ( ref $val eq 'HASH' ) {
143 $rv = 0;
144 Parse::PlainConfig::Legacy::ERROR =
145 pdebug( '%s\'s value must be a hash reference',
146 PPCDLEVEL1, $arg );
147 }
148
149 if ($rv) {
150
151 if ( $arg eq 'COERCE' ) {
152
153 # Validate each key/value pair in COERCE
154 foreach ( keys %$val ) {
155 $ival = defined $$val{$_} ? $$val{$_} : 'undef';
156 unless ( $ival eq 'string'
157 or $ival eq 'list'
158 or $ival eq 'hash' ) {
159 Parse::PlainConfig::Legacy::ERROR = pdebug(
160 'coerced data type (%s: %s) not a string, list, or hash',
161 PPCDLEVEL1, $_, $ival
162 );
163 $rv = 0;
164 }
165 }
166 } elsif ( $arg eq 'DEFAULTS' ) {
167
168 # Copy over the defaults into CONF (not overriding
169 # existing values)
170 while ( ( $k, $v ) = each %{ $$self{DEFAULTS} } ) {
171 $$self{CONF}{$k} = { 'Value' => $v }
172 unless exists $$self{CONF}{$k};
173 }
174 }
175 }
176
177 # TODO: Validate properties like PADDING that have a concrete
178 # TODO: list of valid values?
179
180 } elsif ( ref $val ne '' ) {
181
182 # Everything else should be a scalar value
183 $rv = 0;
184 Parse::PlainConfig::Legacy::ERROR =
185 pdebug( '%s\'s value must be a scalar value',
186 PPCDLEVEL1, $arg );
187 }
188 }
189
190 # Set the value if all's kosher
191 if ($rv) {
192 if ( scalar @args == 2 ) {
193
194 # Assign the value
195 if ( ref $val eq 'ARRAY' ) {
196
197 # Copy array contents in
198 $$self{$arg} = [@$val];
199
200 } elsif ( ref $val eq 'HASH' ) {
201
202 # Copy hash contents in
203 $$self{$arg} = {%$val};
204
205 } else {
206
207 # Assign the scalar value
208 $$self{$arg} = $val;
209 }
210 } else {
211
212 # Copy the value
213 if ( defined $$self{$arg} and ref $$self{$arg} ne '' ) {
214 $rv =
215 ref $$self{$arg} eq 'ARRAY' ? []
216 : ref $$self{$arg} eq 'HASH' ? {}
217 : undef;
218 if ( defined $rv ) {
219 unless ( deepCopy( $$self{$arg}, $rv ) ) {
220 Parse::PlainConfig::Legacy::ERROR =
221 pdebug( 'failed to copy data from %s: %s',
222 PPCDLEVEL1, Paranoid::ERROR, $arg );
223 }
224 } else {
225 Parse::PlainConfig::Legacy::ERROR =
226 pdebug( 'I don\'t know how to copy %s (%s)',
227 PPCDLEVEL1, $$self{$arg}, $arg );
228 }
229 } else {
230 $rv = $$self{$arg};
231 }
232 }
233 }
234
235 pOut();
236 pdebug( 'leaving w/rv: %s', PPCDLEVEL1, $rv );
237
238 return $rv;
239 }
240
241 sub purge {
242
243 # Purpose: Performs a manual purge of internal data
244 # Returns: True
245 # Usage: $obj->purge;
246
247 my $self = shift;
248 my ( $k, $v );
249
250 pdebug( 'entering', PPCDLEVEL1 );
251 pIn();
252
253 # First, purge all existing values
254 delete @{ $$self{CONF} }{ keys %{ $$self{CONF} } };
255
256 # Second, apply default values
257 while ( ( $k, $v ) = each %{ $$self{DEFAULTS} } ) {
258 $$self{CONF}{$k} = { 'Value' => $v };
259 }
260
261 pOut();
262 pdebug( 'leaving w/rv: 1', PPCDLEVEL1 );
263
264 return 1;
265 }
266
267 sub read {
268
269 # Purpose: Reads either the passed filename or an internally recorded one
270 # Returns: True or false depending on success of read & parse
271 # Usage: $rv = $obj->read;
272 # Usage: $rv = $obj->read($filename);
273
274 my $self = shift;
275 my $file = shift || $$self{FILE};
276 my $rv = 0;
277 my $oldSize = PIOMAXFSIZE;
278 my ( $line, @lines );
279
280 croak 'Optional first argument must be a defined filename or the FILE '
281 . 'property must be set'
282 unless defined $file;
283
284 pdebug( 'entering w/(%s)', PPCDLEVEL1, $file );
285 pIn();
286
287 # Reset the error string and update the internal filename
288 Parse::PlainConfig::Legacy::ERROR = '';
289 $$self{FILE} = $file;
290
291 # Temporarily set the specified size limit
292 PIOMAXFSIZE = $$self{MAX_BYTES};
293
294 # Store the file's current mtime
295 $$self{MTIME} = ( stat $file )[MTIME];
296
297 if ( detaint( $file, 'filename' ) ) {
298 if ( slurp( $file, @lines, 1 ) ) {
299
300 # Empty the current config hash and key order
301 $self->purge if $$self{AUTOPURGE};
302
303 # Parse the rc file's lines
304 $rv = $self->_parse(@lines);
305
306 } else {
307 Parse::PlainConfig::Legacy::ERROR =
308 pdebug( Paranoid::ERROR, PPCDLEVEL1 );
309 }
310 } else {
311 Parse::PlainConfig::Legacy::ERROR =
312 pdebug( 'Filename failed detaint check', PPCDLEVEL1 );
313 }
314
315 # Restore old size limit
316 PIOMAXFSIZE = $oldSize;
317
318 pOut();
319 pdebug( 'leaving w/rv: %s', PPCDLEVEL1, $rv );
320
321 # Return the result code
322 return $rv;
323 }
324
325 sub readIfNewer ($) {
326
327 # Purpose: Performs a file read/parse if the file is newer than last read
328 # Returns: 1 if read/parse was successful, 2 if file is the same age, 0
329 # on any errors
330 # Usage: $rv = $obj->readIfNewer;
331
332 my $self = shift;
333 my $file = $$self{FILE};
334 my $omtime = $$self{MTIME};
335 my $rv = 0;
336 my $mtime;
337
338 croak 'The FILE property must be set' unless defined $file;
339
340 pdebug( 'entering w/(%s)', PPCDLEVEL1, $file );
341 pIn();
342
343 # Try to read the file
344 if ( -e $file && -r _ ) {
345
346 # File exists and appears to be readable, get the mtime
347 $mtime = ( stat _ )[MTIME];
348 pdebug( 'current mtime: %s last: %s', PPCDLEVEL2, $mtime, $omtime );
349
350 # Read the file if it's newer, or return 2
351 $rv = $mtime > $omtime ? $self->read : 2;
352
353 } else {
354
355 # Report errors
356 Parse::PlainConfig::Legacy::ERROR =
357 pdebug( 'file (%s) does not exist or is not readable',
358 PPCDLEVEL1, $file );
359 }
360
361 pOut();
362 pdebug( 'leaving w/rv: %s', PPCDLEVEL1, $rv );
363
364 # Return the result code
365 return $rv;
366 }
367
368 sub write {
369
370 # Purpose: Writes the file to disk
371 # Returns: True/False depending on success of write
372 # Usage: $rv = $obj->write;
373 # Usage: $rv = $obj->write($filename);
374
375 my $self = shift;
376 my $file = shift || $$self{FILE};
377 my $padding = shift;
378 my $conf = $$self{CONF};
379 my $order = $$self{ORDER};
380 my $coerce = $$self{COERCE};
381 my $smart = $$self{SMART_PARSER};
382 my $paramDelim = $$self{PARAM_DELIM};
383 my $hashDelim = $$self{HASH_DELIM};
384 my $listDelim = $$self{LIST_DELIM};
385 my $rv = 0;
386 my $tw = DEFAULT_TW;
387 my $delimRegex = qr/(?:\Q$hashDelim\E|\Q$listDelim\E)/sm;
388 my ( @forder, $type, $param, $value, $description, $entry, $out );
389 my ( $tmp, $tvalue, $lines, $fh );
390
391 # TODO: Implement non-blocking flock support
392 # TODO: Store read padding and/or use PADDING property value
393
394 croak 'Optional first argument must be a defined filename or the FILE '
395 . 'property must be set'
396 unless defined $file;
397
398 $padding = 2 unless defined $padding;
399 $tw -= 2 unless $smart;
400
401 pdebug( 'entering w/(%s)(%s)', PPCDLEVEL1, $file, $padding );
402 pIn();
403
404 # Pad the delimiter as specified
405 $paramDelim =
406 $padding == 0 ? $paramDelim
407 : $padding == 1 ? " $paramDelim"
408 : $padding == 2 ? "$paramDelim "
409 : " $paramDelim ";
410 pdebug( 'PARAM_DELIM w/padding is \'%s\'', PPCDLEVEL2, $paramDelim );
411
412 # Create a list of parameters for output
413 @forder = @$order;
414 foreach $tmp ( sort keys %$conf ) {
415 push @forder, $tmp
416 unless grep /^\Q$tmp\E$/sm, @forder;
417 }
418 pdebug( "order of params to be written:\n\t%s", PPCDLEVEL2, @forder );
419
420 # Compose the new output
421 $out = '';
422 foreach $param (@forder) {
423
424 # Determine the datatype
425 $value = exists $$conf{$param} ? $$conf{$param}{Value} : '';
426 $description =
427 exists $$conf{$param} ? $$conf{$param}{Description} : '';
428 $type =
429 exists $$coerce{$param} ? $$coerce{$param}
430 : ref $value eq 'HASH' ? 'hash'
431 : ref $value eq 'ARRAY' ? 'list'
432 : 'string';
433 pdebug( 'adding %s param (%s)', PPCDLEVEL2, $type, $param );
434
435 # Append the comments
436 $out .= $description;
437 $out .= "\n" unless $out =~ /\n$/sm;
438
439 # Start the new entry with the parameter name and delimiter
440 $entry = "$param$paramDelim";
441
442 # Append the value, taking into consideration the smart parser
443 # and coercion settings
444 if ( $type eq 'string' ) {
445
446 # String type
447 $tvalue = $value;
448 unless ( $smart && exists $$coerce{$param} ) {
449 $tvalue =~ s/"/\\"/smg;
450 $tvalue = "\"$tvalue\"" if $tvalue =~ /$delimRegex/sm;
451 }
452 $lines = "$entry$tvalue";
453
454 } elsif ( $type eq 'list' ) {
455
456 # List type
457 $tvalue = [@$value];
458 foreach (@$tvalue) {
459 s/"/\\"/smg;
460 if ( $smart && exists $$coerce{$param} ) {
461 $_ = "\"$_\"" if /\Q$listDelim\E/sm;
462 } else {
463 $_ = "\"$_\"" if /$delimRegex/sm;
464 }
465 }
466 $lines = $entry . join " $listDelim ", @$tvalue;
467
468 } else {
469
470 # Hash type
471 $tvalue = {%$value};
472 foreach ( keys %$tvalue ) {
473 $tmp = $_;
474 $tmp =~ s/"/\\"/smg;
475 $tmp = "\"$tmp\"" if /$delimRegex/sm;
476 if ( $tmp ne $_ ) {
477 $$tvalue{$tmp} = $$tvalue{$_};
478 delete $$tvalue{$_};
479 }
480 $$tvalue{$tmp} =~ s/"/\\"/smg;
481 $$tvalue{$tmp} = "\"$$tvalue{$tmp}\""
482 if $$tvalue{$tmp} =~ /$delimRegex/sm;
483 }
484 $lines = $entry
485 . join " $listDelim ",
486 map {"$_ $hashDelim $$tvalue{$_}"} sort keys %$tvalue;
487 }
488
489 # wrap the output to the column width and append to the output
490 $out .= _wrap( '', "\t", $tw, ( $smart ? "\n" : "\\\n" ), $lines );
491 $out .= "\n" unless $out =~ /\n$/sm;
492 }
493
494 # Write the file
495 if ( detaint( $file, 'filename' ) ) {
496 if ( open $fh, '>', $file ) {
497
498 # Write the file
499 flock $fh, LOCK_EX;
500 if ( print $fh $out ) {
501 $rv = 1;
502 } else {
503 Parse::PlainConfig::Legacy::ERROR = $!;
504 }
505 flock $fh, LOCK_UN;
506 close $fh;
507
508 # Store the new mtime on successful writes
509 $$self{MTIME} = ( stat $file )[MTIME] if $rv;
510
511 } else {
512
513 # Report the errors
514 Parse::PlainConfig::Legacy::ERROR =
515 pdebug( 'error writing file: %s', PPCDLEVEL1, $! );
516 }
517 } else {
518
519 # Detainting filename failed
520 Parse::PlainConfig::Legacy::ERROR =
521 pdebug( 'illegal characters in filename: %s', PPCDLEVEL1, $file );
522 }
523
524 pOut();
525 pdebug( 'leaving w/rv: %s', PPCDLEVEL1, $rv );
526
527 return $rv;
528 }
529
530 sub parameters {
531
532 # Purpose: Returns a list of all parsed parameters
533 # Returns: List of parameter names with configure values
534 # Usage: @params = $obj->parameters;
535
536 my $self = shift;
537 my @parameters = keys %{ $$self{CONF} };
538
539 pdebug( 'called method -- rv: %s', PPCDLEVEL1, @parameters );
540
541 return @parameters;
542 }
543
544 sub parameter {
545
546 # Purpose: Gets/sets named parameter
547 # Returns: True/false in set mode, Parameter value in get mode
548 # Usage: $rv = $obj->parameter($name);
549 # Usage: $rv = $obj->parameter($name, $value);
550
551 my $self = shift;
552 my @args = @_;
553 my $param = $args[0];
554 my $value = $args[1];
555 my $ivalue = defined $value ? $value : 'undef';
556 my $conf = $$self{CONF};
557 my $listDelim = $$self{LIST_DELIM};
558 my $hashDelim = $$self{HASH_DELIM};
559 my $paramDelim = $$self{PARAM_DELIM};
560 my $coerceType =
561 exists $$self{COERCE}{$param}
562 ? $$self{COERCE}{$param}
563 : 'undef';
564 my $defaults = $$self{DEFAULTS};
565 my $rv = 1;
566 my $delimRegex = qr/(?:\Q$hashDelim\E|\Q$listDelim\E)/sm;
567 my ( $finalValue, @elements );
568
569 # TODO: Consider storing a list/hash padding value as well, for use
570 # TODO: in coercion to string.
571
572 croak 'Mandatory firest argument must be a defined parameter name'
573 unless defined $param;
574
575 pdebug( 'entering w/(%s)(%s)', PPCDLEVEL1, $param, $ivalue );
576 pIn();
577
578 if ( scalar @args == 2 ) {
579 pdebug( 'method in set mode', PPCDLEVEL1 );
580
581 # Create a blank record if it hasn't been defined yet
582 $$conf{$param} = {
583 Value => '',
584 Description => '',
585 }
586 unless exists $$conf{$param};
587
588 # Start processing value assignment
589 if ( $coerceType ne 'undef' ) {
590 pdebug( 'coercing into %s', PPCDLEVEL2, $coerceType );
591
592 # Parameter has a specific data type to be coerced into
593 if ( $coerceType eq 'string' && ref $value ne '' ) {
594
595 # Coerce values into strings
596 if ( ref $value eq 'ARRAY' ) {
597
598 # Convert lists into a string using the list delimiter
599 foreach (@$value) {
600 s/"/\\"/smg;
601 $_ = "\"$_\"" if /\Q$listDelim\E/sm;
602 }
603 $finalValue = join " $listDelim ", @$value;
604
605 } elsif ( ref $value eq 'HASH' ) {
606
607 # Convert hashes into a string using the hash & list
608 # delimiters
609 foreach ( sort keys %$value ) {
610 $ivalue = $_;
611 $ivalue =~ s/"/\\"/smg;
612 $ivalue = "\"$ivalue\""
613 if /(?:\Q$hashDelim\E|\Q$listDelim\E)/sm;
614 $$value{$_} = '' unless defined $$value{$_};
615 $$value{$_} = "\"$$value{$_}\""
616 if $$value{$_} =~
617 /(?:\Q$hashDelim\E|\Q$listDelim\E)/sm;
618 push @elements,
619 join " $hashDelim ", $_,
620 ( defined $$value{$_} ? $$value{$_} : '' );
621 }
622 $finalValue = join " $listDelim ", @elements;
623
624 } else {
625
626 # Try to stringify everything else
627 $finalValue = "$value";
628 }
629
630 } elsif ( $coerceType eq 'list' && ref $value ne 'ARRAY' ) {
631
632 # Coerce value into a list
633 if ( ref $value eq 'HASH' ) {
634
635 # Convert hashes into a list
636 $finalValue = [];
637 foreach ( sort keys %$value ) {
638 push @$finalValue, $_, $$value{$_};
639 }
640
641 } elsif ( ref $value eq '' ) {
642
643 # Convert strings into a list
644 $self->_parse(
645 split /\n/sm,
646 "$$conf{$param}{Description}\n"
647 . "$param $paramDelim $value"
648 );
649 $finalValue = $$conf{$param}{Value};
650
651 } else {
652
653 # Stringify everything else and put it into an array
654 $finalValue = ["$value"];
655 }
656
657 } elsif ( $coerceType eq 'hash' && ref $value ne 'HASH' ) {
658
659 # Coerce value into a hash
660 if ( ref $value eq 'ARRAY' ) {
661
662 # Convert a list into a hash using every two elements
663 # as a key/value pair
664 push @$value, ''
665 unless int( scalar @$value / 2 ) ==
666 scalar @$value / 2;
667 $finalValue = {@$value};
668
669 } elsif ( ref $value eq '' ) {
670
671 # Convert strings into a hash
672 $self->_parse(
673 split /\n/sm,
674 "$$conf{$param}{Description}\n"
675 . "$param $paramDelim $value"
676 );
677 $finalValue = $$conf{$param}{Value};
678
679 } else {
680
681 # Stringify everything else and put the value into the
682 # hash key
683 $finalValue = { "$value" => '' };
684 }
685
686 } else {
687
688 # No coercion is necessary
689 $finalValue = $value;
690 }
691
692 } else {
693 pdebug( 'no coercion to do', PPCDLEVEL2 );
694 $finalValue = $value;
695 }
696 $$conf{$param}{Value} = $finalValue;
697
698 } else {
699 pdebug( 'method in retrieve mode', PPCDLEVEL1 );
700 $rv =
701 exists $$conf{$param} ? $$conf{$param}{Value}
702 : exists $$defaults{$param} ? $$defaults{$param}
703 : undef;
704 }
705
706 pOut();
707 pdebug( 'leaving w/rv: %s', PPCDLEVEL1, $rv );
708
709 return ref $rv eq 'HASH' ? (%$rv) : ref $rv eq 'ARRAY' ? (@$rv) : $rv;
710 }
711
712 sub coerce {
713
714 # Purpose: Assigns the passed list to a data type and attempts to
715 # coerce each existing value into that data type.
716 # Returns: True or false.
717 # Usage: $rv = $obj->coerce($type, @fields);
718
719 my $self = shift;
720 my $type = shift;
721 my $itype = defined $type ? $type : 'undef';
722 my @params = @_;
723 my $rv = 1;
724
725 croak 'Mandatory first argument must be "string", "list", or "hash"'
726 unless $itype eq 'string'
727 or $itype eq 'list'
728 or $itype eq 'hash';
729 croak 'Remaining arguments must be defined parameter names'
730 unless @params;
731
732 pdebug( 'entering w/(%s)(%s)', PPCDLEVEL1, $type, @params );
733 pIn();
734
735 foreach (@params) {
736 if (defined) {
737
738 # Mark the parameter
739 $$self{COERCE}{$_} = $type;
740 $self->parameter( $_, $$self{CONF}{$_}{Value} )
741 if exists $$self{CONF}{$_};
742 } else {
743
744 # Report undefined parameter names
745 Parse::PlainConfig::Legacy::ERROR =
746 pdebug( 'passed undefined parameter names to coerce',
747 PPCDLEVEL1 );
748 $rv = 0;
749 }
750 }
751
752 pOut();
753 pdebug( 'leaving w/rv: %s', PPCDLEVEL1, $rv );
754
755 return $rv;
756 }
757
758 sub describe {
759
760 # Purpose: Assigns descriptive comments to specific parameters
761 # Returns: True
762 # Usage: $obj->describe(%descriptions);
763
764 my $self = shift;
765 my $conf = $$self{CONF};
766 my $coerce = $$self{COERCE};
767 my %new = (@_);
768
769 pdebug( 'entering', PPCDLEVEL1 );
770 pIn();
771
772 # TODO: Consider allowing comment tags to be specified
773
774 # TODO: Consider line splitting and comment tag prepending where
775 # TODO: it's not already done.
776
777 foreach ( keys %new ) {
778 pdebug( '%s is described as \'%s\'', PPCDLEVEL1, $_, $new{$_} );
779 unless ( exists $$conf{$_} ) {
780 $$conf{$_} = {};
781 if ( exists $$coerce{$_} ) {
782 $$conf{$_}{Value} =
783 $$coerce{$_} eq 'list' ? []
784 : $$coerce{$_} eq 'hash' ? {}
785 : '';
786 } else {
787 $$conf{$_}{Value} = '';
788 }
789 }
790 $$conf{$_}{Description} = $new{$_};
791 }
792
793 pOut();
794 pdebug( 'leaving w/rv: 1', PPCDLEVEL1 );
795
796 return 1;
797 }
798
799 sub order {
800
801 # Purpose: Gets/sets order of parameters in file
802 # Returns: Ordered list of named parameters
803 # Usage: @params = $obj->order;
804 # Usage: @params = $obj->order(@newOrder);
805
806 my $self = shift;
807 my $order = $$self{ORDER};
808 my @new = (@_);
809
810 pdebug( 'entering w/(%s)', PPCDLEVEL1, @new );
811
812 @$order = (@new) if scalar @new;
813
814 pdebug( 'leaving w/rv: %s', PPCDLEVEL1, @$order );
815
816 return @$order;
817 }
818
819 sub _parse {
820
821 # Purpose: Parses the passed list of lines and extracts comments,
822 # fields, and values and storing everything into the CONF
823 # hash
824 # Returns: True or false
825 # Usage: $rv = $obj->_parse(@lines);
826
827 my $self = shift;
828 my $conf = $$self{CONF};
829 my $order = $$self{ORDER};
830 my $smart = $$self{SMART_PARSER};
831 my $tagDelim = $$self{PARAM_DELIM};
832 my $hashDelim = $$self{HASH_DELIM};
833 my $listDelim = $$self{LIST_DELIM};
834 my @lines = @_;
835 my $rv = 1;
836 my ( $i, $line, $comment, $entry, $field, $value );
837 my ( $indentation, $data, $saveEntry );
838
839 # Make sure some of the properties are sane
840 croak 'LIST_DELIM and HASH_DELIM cannot be the same character sequence!'
841 unless $$self{LIST_DELIM} ne $$self{HASH_DELIM};
842
843 pdebug( 'entering', PPCDLEVEL2 );
844 pIn();
845
846 # Flatten lines using an explicit backslash
847 for ( $i = 0; $i <= $#lines; $i++ ) {
848
849 # Let's disable uninitialized warnings since there's a few
850 # places here we really don't care
851 no warnings 'uninitialized';
852
853 if ( $lines[$i] =~ /\\\s*$/sm ) {
854 pdebug( 'joining lines %s & %s', PPCDLEVEL2, $i + 1, $i + 2 );
855
856 # Lop off the trailing whitespace and backslash, preserving
857 # only one space on the assumption that if it's there it's a
858 # natural word break.
859 $lines[$i] =~ s/(\s)?\s*\\\s*$/$1/sm;
860
861 # Concatenate the following line (if there is one) after stripping
862 # off preceding whitespace
863 if ( $i < $#lines ) {
864 $lines[ $i + 1 ] =~ s/^\s+//sm;
865 $lines[$i] .= $lines[ $i + 1 ];
866 splice @lines, $i + 1, 1;
867 --$i;
868 }
869 }
870 }
871
872 $saveEntry = sub {
873
874 # Saves the extracted data into the conf hash and resets
875 # the vars.
876
877 my ($type);
878
879 ( $field, $value ) =
880 ( $entry =~ /^\s*([^$tagDelim]+?)\s*\Q$tagDelim\E\s*(.*)$/sm );
881 pdebug( "saving data:\n\t(%s: %s)", PPCDLEVEL2, $field, $value );
882
883 if ( exists $$self{COERCE}{$field} ) {
884
885 # Get the field data type from COERCE
886 $type = $$self{COERCE}{$field};
887
888 } else {
889
890 # Otherwise, try to autodetect data type
891 $type =
892 scalar quotewords( qr/\s*\Q$hashDelim\E\s*/sm, 0, $value ) > 1
893 ? 'hash'
894 : scalar quotewords( qr/\s*\Q$listDelim\E\s*/sm, 0, $value ) >
895 1 ? 'list'
896 : 'scalar';
897 }
898 pdebug( 'detected type of %s is %s', PPCDLEVEL2, $field, $type );
899
900 # For all data types we should strip leading/trailing whitespace.
901 # If they really want it they should quote it.
902 $value =~ s/^\s+|\s+$//smg unless $type eq 'scalar';
903
904 # We'll apply quotewords to scalar values only if the smart parser is
905 # not being used or if we're not coercing all values into scalar for
906 # this field.
907 #
908 # I hate having to do this but I was an idiot in the previous versions
909 # and this is necessary for backwards compatibility.
910 if ( $type eq 'scalar' ) {
911 $value = join '',
912 quotewords( qr/\s*\Q$listDelim\E\s*/sm, 0, $value )
913 unless $smart
914 && exists $$self{COERCE}{$field}
915 && $$self{COERCE}{$field} eq 'scalar';
916 } elsif ( $type eq 'hash' ) {
917 $value = {
918 quotewords(
919 qr/\s*(?:\Q$hashDelim\E|\Q$listDelim\E)\s*/sm, 0,
920 $value
921 ) };
922 } elsif ( $type eq 'list' ) {
923 $value = [ quotewords( qr/\s*\Q$listDelim\E\s*/sm, 0, $value ) ];
924 }
925
926 # Create the parameter record
927 $$conf{$field} = {};
928 $$conf{$field}{Value} = $value;
929 $$conf{$field}{Description} = $comment;
930 push @$order, $field unless grep /^\Q$field\E$/sm, @$order;
931 $comment = $entry = '';
932 };
933
934 # Process lines
935 $comment = $entry = '';
936 while ( defined( $line = shift @lines ) ) {
937
938 if ( $line =~ /^\s*(?:#.*)?$/sm ) {
939
940 # Grab comments and blank lines
941 pdebug( "comment/blank line:\n\t%s", PPCDLEVEL3, $line );
942
943 # First save previous entries if $entry has content
944 &$saveEntry() and $i = 0 if length $entry;
945
946 # Save the comments
947 $comment = length($comment) > 0 ? "$comment$line\n" : "$line\n";
948
949 } else {
950
951 # Grab configuration lines
952
953 # If this is the first line of a new entry and there's no
954 # PARAM_DELIM skip the line -- something must be wrong.
955 #
956 # TODO: Error out/raise exception
957 unless ( length $entry || $line =~ /\Q$tagDelim\E/sm ) {
958 pdebug( "skipping spurious text:\n\t%s", PPCDLEVEL3, $line );
959 next;
960 }
961
962 # Grab indentation characters and line content
963 ( $indentation, $data ) = ( $line =~ /^(\s*)(.+)$/sm );
964 pdebug( "data line:\n\t%s", PPCDLEVEL3, $data );
965
966 if ($smart) {
967
968 # Smart parsing is enabled
969
970 if ( length $entry ) {
971
972 # There's current content
973
974 if ( length($indentation) > $i ) {
975
976 # If new indentation is greater than original
977 # indentation we concatenate the lines as a
978 # continuation
979 $entry .= $data;
980
981 } else {
982
983 # Otherwise we treat this a a new entry, so we save
984 # the old and store the current
985 &$saveEntry();
986 ( $i, $entry ) = ( length($indentation), $data );
987 }
988
989 } else {
990
991 # No current content, so just store the current data and
992 # continue processing
993 ( $i, $entry ) = ( length($indentation), $data );
994 }
995
996 } else {
997
998 # Smart parsing is disabled, so treat every line as a new
999 # entry
1000 $entry = $data;
1001 &$saveEntry();
1002 }
1003 }
1004 }
1005 &$saveEntry() if length $entry;
1006
1007 pOut();
1008 pdebug( 'leaving w/rv: %s', PPCDLEVEL2, $rv );
1009
1010 return $rv;
1011 }
1012
1013 sub _wrap {
1014
1015 # Purpose: Parses the passed line of test and inserts indentation and
1016 # line breaks as needed
1017 # Returns: Formated string
1018 # Usage: $out = $obj->_wrap($fIndent, $sIndent, $textWidth,
1019 # $lineBreak, $paragraph);
1020
1021 my $firstIndent = shift;
1022 my $subIndent = shift;
1023 my $textWidth = shift;
1024 my $lineBreak = shift;
1025 my $paragraph = shift;
1026 my ( @lines, $segment, $output );
1027
1028 pdebug( "entering w/(%s)(%s)(%s)(%s):\n\t%s",
1029 PPCDLEVEL2, $firstIndent, $subIndent, $textWidth, $lineBreak,
1030 $paragraph );
1031 pIn();
1032
1033 # Expand tabs in everything -- sorry everyone
1034 ($firstIndent) = expand($firstIndent);
1035 ($subIndent) = expand($subIndent);
1036 $paragraph = expand("$firstIndent$paragraph");
1037
1038 $lines[0] = '';
1039 while ( length($paragraph) > 0 ) {
1040
1041 # Get the next string segment (splitting on whitespace)
1042 ($segment) = ( $paragraph =~ /^(\s*\S+\s?)/sm );
1043
1044 if ( length $segment <= $textWidth - length $lines[-1] ) {
1045
1046 # The segment will fit appended to the current line,
1047 # concatenate it
1048 $lines[-1] .= $segment;
1049
1050 } elsif ( length $segment <= $textWidth - length $subIndent ) {
1051
1052 # The segment will fit into the next line, add it
1053 $lines[-1] .= $lineBreak;
1054 push @lines, "$subIndent$segment";
1055
1056 } else {
1057
1058 # Else, split on the text width
1059 $segment =
1060 $#lines == 0
1061 ? substr $paragraph, 0, $textWidth
1062 : substr $paragraph, 0, $textWidth - length $subIndent;
1063 if ( length $segment > $textWidth - length $lines[-1] ) {
1064 $lines[-1] .= $lineBreak;
1065 push @lines,
1066 ( $#lines == 0 ? $segment : "$subIndent$segment" );
1067 } else {
1068 $lines[-1] .= $segment;
1069 }
1070 }
1071 $paragraph =~ s/^.{@{[length($segment)]}}//sm;
1072 }
1073 $lines[-1] .= "\n";
1074
1075 $output = join '', @lines;
1076
1077 pOut();
1078 pdebug( "leaving w/rv:\n%s", PPCDLEVEL2, $output );
1079
1080 return $output;
1081 }
1082
1083 sub hasParameter {
1084
1085 # Purpose: Checks to see if the specified parameter exists as a
1086 # configuration parameter
1087 # Returns: True or false
1088 # Usage: $rv = $obj->hasParameter($name);
1089
1090 my $self = shift;
1091 my $param = shift;
1092 my $rv = 0;
1093 my @params = ( keys %{ $self->{CONF} }, keys %{ $self->{DEFAULTS} }, );
1094
1095 croak 'Mandatory first parameter must be a defined parameter name'
1096 unless defined $param;
1097
1098 pdebug( 'entering w/(%s)', PPCDLEVEL1, $param );
1099 pIn();
1100
1101 $rv = scalar grep /^\Q$param\E$/sm, @params;
1102
1103 pOut();
1104 pdebug( 'leaving w/rv: %s', PPCDLEVEL1, $rv );
1105
1106 return $rv;
1107 }
1108
1109 1;
1110
1111 __END__
1112
1113 =head1 NAME
1114
1115 Parse::PlainConfig::Legacy - Parsing engine Legacy for Parse::PlainConfig
1116
1117 =head1 VERSION
1118
1119 $Id: lib/Parse/PlainConfig/Legacy.pm, 3.02 2016/05/26 13:04:45 acorliss Exp $
1120
1121 =head1 SYNOPSIS
1122
1123 use Parse::PlainConfig::Legacy;
1124
1125 $conf = new Parse::PlainConfig::Legacy;
1126 $conf = Parse::PlainConfig->new(
1127 'PARAM_DELIM' => '=',
1128 'FILE' => '.myrc',
1129 'MAX_BYTES' => 65536,
1130 'SMART_PARSER => 1,
1131 );
1132
1133 $conf->property(PARAM_DELIM => '=');
1134
1135 $rv = $conf->read('myconf.conf');
1136 $rv = $conf->read;
1137 $rv = $conf->readIfNewer;
1138 $conf->write('.myrc', 2);
1139
1140 $conf->purge;
1141
1142 @parameters = $conf->parameters;
1143 $conf->parameter(FOO => "bar");
1144 $value = $conf->parameter(FOO);
1145 $conf->describe(FOO => 'This is foo');
1146 $conf->coerce("string", qw(FOO BAR));
1147
1148 @order = $conf->order;
1149 $conf->order(@new_order);
1150
1151 $errstr = Parse::PlainConfig::Parse::PlainConfig::Legacy::ERROR;
1152
1153 $rv = $conf->hasParameter('FOO');
1154
1155 =head1 DESCRIPTION
1156
1157 Parse::PlainConfig::Legacy provides OO objects which can parse and generate
1158 human-readable configuration files.
1159
1160 =head1 SUBROUTINES/METHODS
1161
1162 =head2 new
1163
1164 $conf = new Parse::PlainConfig;
1165 $conf = Parse::PlainConfig->new(
1166 'PARAM_DELIM' => '=',
1167 'FILE' => '.myrc',
1168 'MAX_BYTES' => 65536,
1169 'SMART_PARSER => 1,
1170 );
1171
1172 The object constructor can be called with or without arguments. Arguments
1173 available for use include:
1174
1175 Argument Default Purpose
1176 =============================================================
1177 ORDER [] Specifies specific order of
1178 fields to be used while writing
1179 FILE undef Filename for read/write ops
1180 PARAM_DELIM ':' Field/value delimiter
1181 LIST_DELIM ',' List delimiter within field values
1182 HASH_DELIM '=>' Hash key/value delimiter within
1183 field values
1184 AUTOPURGE 0 Autopurge enabled/disabled
1185 COERCE {} Field coercion hash
1186 DEFAULTS {} Default field values
1187 SMART_PARSER 0 Smart parser enabled/disabled
1188 MAX_BYTES 16384 Integer denoting maximum bytes
1189 to read in any given file
1190 DEFAULTS {} Specifies default values for config
1191 parameters if not specified/parsed
1192
1193 B<COERCE> is a hash of field name/data type pairs. If a field is listed in
1194 this hash then their values will always be returned in the requested format of
1195 either string, list, or hash. Any field coerced to string, for instance, will
1196 ignore list and hash delimiters and assume the entire value will always be
1197 string value.
1198
1199 B<DEFAULTS> is a hash of field name/value pairs. This ensures that even if a
1200 field is not explicitly set (either in a conf file or programmatically) a
1201 default value can still be retrieved.
1202
1203 B<SMART_PARSER> removes the need to backslash end-of-lines to continue the
1204 value onto the next. If the following line is indented further than the tag
1205 was it will automatically assume that the next line is a continuation of the
1206 previous. It also affects the need to encapsulate coerced datatypes with
1207 quotation marks for irrelevant delimiters.
1208
1209 B<AUTOPURGE> erases all stored parameters and values and applies the defaults
1210 (if any) before reading a file. This does not, however, erase any values
1211 set for B<ORDER>.
1212
1213 =head2 property
1214
1215 $conf->property(PARAM_DELIM => '=');
1216
1217 This method sets or retrieves the specified property. Please note
1218 that this B<overwrites> the current value, even for those properties that are
1219 references to lists and hashes.
1220
1221 If you're using this to set a property it will return a boolean true or false
1222 depending on the success of the operation. If you're just retrieving a
1223 property it will return the value of the property. If you ask for a
1224 nonexistent property it will B<croak>.
1225
1226 B<NOTE:> As of version 2.07 all hashes and lists are copied both in and out of
1227 the object, so any alterations to a referenced structure retrieved will have
1228 no effect on the property within the object.
1229
1230 =head2 purge
1231
1232 $conf->purge;
1233
1234 This method performs an immediate manual purge. Auto-purge mode clears the
1235 configuration hash each time a configuration file is read, so that the internal
1236 configuration data consists solely of what is in that file. If you wanted to
1237 combine the settings of multiple files that each may exclusively hold some
1238 directives, setting this to 'off' will load the combined configuration as you
1239 read each file.
1240
1241 You can still clobber configuration values, of course, if the same directive
1242 is defined in multiple files. In that case, the last file's value will be the
1243 one stored in the hash.
1244
1245 This does not clear the B<order> or B<coerce> properties.
1246
1247 Autopurge mode is disabled by default.
1248
1249 =head2 read
1250
1251 $rv = $conf->read('myconf.conf');
1252 $rv = $conf->read;
1253
1254 The read method is called initially with a filename as the only argument.
1255 This causes the parser to read the file and extract all of the configuration
1256 directives from it.
1257
1258 You'll notice that you can also call the read method without an argument.
1259 The name of the file read is stored internally, and if already set to a valid
1260 value (either by a previous call to B<read> with a filename argument or by
1261 setting the B<FILE> property) this will read that file's contents.
1262
1263 The return value will be one if the file was successfully read and parsed,
1264 or zero otherwise. The reason for failure can be read via
1265 B<Parse::PlainConfig::Parse::PlainConfig::Legacy::ERROR>.
1266
1267 This function will cause the program to croak if called without a filename
1268 ever being defined.
1269
1270 =head2 readIfNewer
1271
1272 $rv = $conf->readIfNewer;
1273
1274 This method is used to reread & parse the file only if the mtime appears
1275 newer than when last read. If the file was successfully reread or appears to
1276 be the same it will return true. Any errors will be stored in
1277 B<Parse::PlainConfig::Legacy::ERROR> and it will return a false value.
1278
1279 You can determine whether or not the file was read by the true value. If it
1280 was re-read it will return 1. If the file appears to be the same age it will
1281 return a 2.
1282
1283 =head2 write
1284
1285 $conf->write('.myrc', 2);
1286
1287 This method writes the current configuration stored in memory to the specified
1288 file, either specified as the first argument, or as stored from an explicit or
1289 implicit B<read> call.
1290
1291 The second argument specifies what kind of whitespace padding, if any, to use
1292 with the directive/value delimiter. The following values are recognised:
1293
1294 Value Meaning
1295 ================================================
1296 0 No padding (i.e., written as KEY:VALUE)
1297 1 Left padding (i.e., written as KEY :VALUE)
1298 2 Right padding (i.e., written as KEY: VALUE)
1299 3 Full padding (i.e., written as KEY : VALUE)
1300
1301 Both arguments are optional.
1302
1303 =head2 parameters
1304
1305 @parameters = $conf->parameters;
1306
1307 This method returns a list of all the names of the directives currently
1308 stored in the configuration hash in no particular order.
1309
1310 =head2 parameter
1311
1312 $value = $conf->parameter('SCALAR1');
1313 @values = $conf->parameter('LIST1');
1314 %values = $conf->parameter('HASH1');
1315 $conf->parameter('SCALAR1', "foo");
1316 $conf->parameter('LIST1', [qw(foo bar)]);
1317 $conf->parameter('HASH1', { foo => 'bar' });
1318
1319 This method sets or retrieves the specified parameter. Hash and list values
1320 are copied and returned as a list. If the specified parameter is set to be
1321 coerced into a specific data type the specified value will be converted to
1322 that datatype. This means you can do something like:
1323
1324 # SCALAR1 will equal "foo , bar , roo" assuming LIST_DELIM is set to ','
1325 $conf->coerce(qw(string SCALAR1));
1326 $conf->parameter('SCALAR1', [qw(foo bar roo)]);
1327
1328 # SCALAR1 will equal "foo => bar : roo => ''" assuming HASH_DELIM is set
1329 # to '=>' and LIST_DELIM is set to ':'
1330 $conf->parameter('SCALAR1', { 'foo' => 'bar', 'roo' => '' });
1331
1332 In order for conversions to be somewhat predictable (in the case of hashes
1333 coerced into other values) hash key/value pairs will be assigned to string
1334 or list portions according to the alphabetic sort order of the keys.
1335
1336 =head2 coerce
1337
1338 $conf->coerce("string", "FOO", "BAR");
1339
1340 This method configures the parser to coerce values into the specified
1341 datatype (either string, list, or hash) and immediately convert any existing
1342 values and store them into that datatype as well.
1343
1344 B<NOTE:> Coercing existing values into another data type can provide for some
1345 interesting conversions. Strings, for instance, are split on the list
1346 delimiter when converting to arrays, and similarly on list and hash delimiters
1347 for hashes. Going from a hash or list to a string is done in the opposite
1348 manner, elements/key-value pairs are joined with the applicable delimiters and
1349 concatenated into a string.
1350
1351 For this reason one should try to avoid coercing one data type into another if
1352 you can avoid it. Instead one should predefine what the data types for each
1353 parameter should be and define that in the COERCE hash passed during object
1354 instantiation, or via this method prior to reading and parsing a file.
1355
1356 =head2 describe
1357
1358 $conf->describe(KEY1 => 'This is foo', KEY2 => 'This is bar');
1359
1360 The describe method takes any number of key/description pairs which will be
1361 used as comments preceding the directives in any newly written conf file. You
1362 are responsible for prepending a comment character to each line, as well as
1363 splitting along your desired text width.
1364
1365 =head2 order
1366
1367 @order = $conf->order;
1368 $conf->order(@new_order);
1369
1370 This method returns the current order of the configuration directives as read
1371 from the file. If called with a list as an argument, it will set the
1372 directive order with that list. This method is probably of limited use except
1373 when you wish to control the order in which directives are written in new conf
1374 files.
1375
1376 Please note that if there are more directives than are present in this list,
1377 those extra keys will still be included in the new file, but will appear in
1378 alphabetically sorted order at the end, after all of the keys present in the
1379 list.
1380
1381 =head2 hasParameter
1382
1383 $rv = $conf->hasParameter('FOO');
1384
1385 This function allows you to see if a parameter has been defined or has a
1386 default set for it. Returns a boolean value.
1387
1388 =head1 DEPRECATED METHODS
1389
1390 =head2 delim
1391
1392 $conf->delim('=');
1393
1394 This method gets and/or sets the parameter name/value delimiter to be used in the
1395 conf files. The default delimiter is ':'. This can be multiple characters.
1396
1397 =head2 directives
1398
1399 @directives = $conf->directives;
1400
1401 This method returns a list of all the names of the directives currently
1402 stored in the configuration hash in no particular order.
1403
1404 =head2 get
1405
1406 $field = $conf->get('KEY1');
1407 ($field1, $field2) = $conf->get(qw(KEY1 KEY2));
1408
1409 The get method takes any number of directives to retrieve, and returns them.
1410 Please note that both hash and list values are passed by reference. In order
1411 to protect the internal state information, the contents of either reference is
1412 merely a copy of what is in the configuration object's hash. This will B<not>
1413 pass you a reference to data stored internally in the object. Because of
1414 this, it's perfectly safe for you to shift off values from a list as you
1415 process it, and so on.
1416
1417 =head2 set
1418
1419 $conf->set(KEY1 => 'foo', KEY2 => 'bar');
1420
1421 The set method takes any number of directive/value pairs and copies them into
1422 the internal configuration hash.
1423
1424 =head2 get_ref
1425
1426 $href = $conf->get_ref
1427
1428 B<Note>: This used to give you a reference to the internal configuration hash
1429 so you could manipulate it directly. It now only gives you a B<copy> of the
1430 internal hash (actually, it's reconstructed has to make it look like the old
1431 data structure). In short, any changes you make to this hash B<will be lost>.
1432
1433 =head2 error
1434
1435 warn $conf->error;
1436
1437 This method returns a zero-length string if no errors were registered with the
1438 last operation, or a text message describing the error.
1439
1440 =head2 ERROR
1441
1442 $error = Parse::PlainConfig::ERROR();
1443
1444 Lvalue subroutine storing the last error which may have occurred.
1445
1446 =head1 DEPENDENCIES
1447
1448 =over
1449
1450 =item o
1451
1452 L<Paranoid>
1453
1454 =item o
1455
1456 L<Text::ParseWords>
1457
1458 =item o
1459
1460 L<Text::Tabs>
1461
1462 =back
1463
1464 =head1 FILE SYNTAX
1465
1466 =head2 TRADITIONAL USAGE
1467
1468 The plain parser supports the reconstructions of relatively simple data
1469 structures. Simple string assignments and one-dimensional arrays and hashes
1470 are possible. Below are are various examples of constructs:
1471
1472 # Scalar assignment
1473 FIRST_NAME: Joe
1474 LAST_NAME: Blow
1475
1476 # Array assignment
1477 FAVOURITE_COLOURS: red, yellow, green
1478 ACCOUNT_NUMBERS: 9956-234-9943211, \
1479 2343232-421231445, \
1480 004422-03430-0343
1481
1482 # Hash assignment
1483 CARS: crown_vic => 1982, \
1484 geo => 1993
1485
1486 As the example above demonstrates, all lines that begin with a '#' (leading
1487 whitespace is allowed) are ignored as comments. if '#" occurs in any other
1488 position, it is accepted as part of the passed value. This means that you
1489 B<cannot> place comments on the same lines as values.
1490
1491 All directives and associated values will have both leading and trailing
1492 whitespace stripped from them before being stored in the configuration hash.
1493 Whitespace is allowed within both.
1494
1495 In traditional mode (meaning no parameters are set to be coerced into a
1496 specific datatype) one must encapsulate list and hash delimiters with
1497 quotation marks in order to prevent the string from being split and stored as
1498 a list or hash. Quotation marks that are a literal part of the string must be
1499 backslashed.
1500
1501 =head2 SMART PARSER
1502
1503 The new parser now provides some options to make the file syntax more
1504 convenient. You can activate the smart parser by setting B<SMART_PARSER> to a
1505 true value during object instantiation or via the B<property> method.
1506
1507 With the traditional parser you had to backslach the end of all preceding
1508 lines if you wanted to split a value into more than one line:
1509
1510 FOO: This line starts here \
1511 and ends here...
1512
1513 With the smart parser enabled that is no longer necessary as long as the
1514 following lines are indented further than the first line:
1515
1516 FOO: This line starts here
1517 and ends here...
1518
1519 B<Note:> The indentation is compared by byte count with no recognition of
1520 tab stops. That means if you indent with spaces on the first line and indent
1521 with tabs on the following it may not concantenate those values.
1522
1523 Another benefit of the smart parser is found when you specify a parameter to
1524 be of a specific datatype via the B<COERCE> hash during object instantiation
1525 or the B<coerce> method. For instance, the traditional parser requires you to
1526 encapsulate strings with quotation marks if they contain list or hash
1527 delimiters:
1528
1529 Quote: "\"It can't be that easy,\" he said."
1530
1531 Also note how you had to escape quotation marks if they were to be a literal
1532 part of the string. With this parameter set to be coerced to a scalar you can
1533 simply write:
1534
1535 Quote: "It can't be that easy," he said.
1536
1537 Similarly, you don't have to quote hash delimiters in parameters set to be
1538 coerced into lists. Quotation marks as part of an element value must be
1539 escaped, though, since unescaped quotation marks are assumed to encapsulate
1540 strings containing list delimiters you don't want to split on.
1541
1542 B<Note:> The previous versions of Parse::PlainConfig did not allow the user to
1543 set keys like:
1544
1545 FOO: \
1546 bar
1547
1548 or save empty assignments like
1549
1550 FOO:
1551
1552 This is no longer the case. Both are now valid and honoured.
1553
1554 =head1 SECURITY
1555
1556 B<WARNING:> This parser will attempt to open what ever you pass to it for a
1557 filename as is. If this object is to be used in programs that run with
1558 permissions other than the calling user, make sure you sanitize any
1559 user-supplied filename strings before passing them to this object.
1560
1561 This also uses a blocking b<flock> call to open the file for reading and
1562 writing.
1563
1564 =head1 DIAGNOSTICS
1565
1566 Through the use of B<Paranoid::Debug> this module will produce internal
1567 diagnostic output to STDERR. It begins logging at log level 7. To enable
1568 debugging output please see the pod for L<Paranoid::Debug>.
1569
1570 =head1 BUGS AND LIMITATIONS
1571
1572 =head1 AUTHOR
1573
1574 Arthur Corliss (corliss@digitalmages.com)
1575
1576 =head1 LICENSE AND COPYRIGHT
1577
1578 This software is licensed under the same terms as Perl, itself.
1579 Please see http://dev.perl.org/licenses/ for more information.
1580
1581 (c) 2002 - 2016, Arthur Corliss (corliss@digitalmages.com)
1582
+251
-0
lib/Parse/PlainConfig/Settings.pm less more
0 # Parse::PlainConfig::Settings -- Settings Class
1 #
2 # (c) 2015, Arthur Corliss <corliss@digitalmages.com>
3 #
4 # $Id: lib/Parse/PlainConfig/Settings.pm, 3.02 2016/05/26 13:04:45 acorliss Exp $
5 #
6 # This software is licensed under the same terms as Perl, itself.
7 # Please see http://dev.perl.org/licenses/ for more information.
8 #
9 #####################################################################
10
11 #####################################################################
12 #
13 # Environment definitions
14 #
15 #####################################################################
16
17 package Parse::PlainConfig::Settings;
18
19 use 5.008;
20
21 use strict;
22 use warnings;
23 use vars qw($VERSION);
24
25 ($VERSION) = ( q$Revision: 3.02 $ =~ /(\d+(?:\.\d+)+)/sm );
26
27 use Paranoid;
28 use Paranoid::Debug;
29 use Parse::PlainConfig::Constants qw(:all);
30 use Class::EHierarchy qw(:all);
31 use vars qw(@ISA @_properties @_methods);
32
33 @ISA = qw(Class::EHierarchy);
34
35 @_properties = (
36 [ CEH_PUB | CEH_SCALAR, 'tab stop', DEFAULT_TAB ],
37 [ CEH_PUB | CEH_SCALAR, 'subindentation', DEFAULT_SUBI ],
38 [ CEH_PUB | CEH_SCALAR, 'comment', DEFAULT_CMMT ],
39 [ CEH_PUB | CEH_SCALAR, 'delimiter', DEFAULT_PDLM ],
40 [ CEH_PUB | CEH_SCALAR, 'list delimiter', DEFAULT_LDLM ],
41 [ CEH_PUB | CEH_SCALAR, 'hash delimiter', DEFAULT_HDLM ],
42 [ CEH_PUB | CEH_SCALAR, 'here doc', DEFAULT_HDOC ],
43 [ CEH_PUB | CEH_HASH, 'property types' ],
44 [ CEH_PUB | CEH_HASH, 'property regexes' ],
45 [ CEH_PUB | CEH_HASH, 'prototypes' ],
46 [ CEH_PUB | CEH_HASH, 'prototype regexes' ],
47 [ CEH_PUB | CEH_HASH, 'prototype registry' ],
48 [ CEH_PUB | CEH_SCALAR, 'error' ],
49 );
50
51 #####################################################################
52 #
53 # Module code follows
54 #
55 #####################################################################
56
57 sub tabStop {
58 my $obj = shift;
59 return $obj->property('tab stop');
60 }
61
62 sub subindentation {
63 my $obj = shift;
64 return $obj->property('subindentation');
65 }
66
67 sub comment {
68 my $obj = shift;
69 return $obj->property('comment');
70 }
71
72 sub delimiter {
73 my $obj = shift;
74 return $obj->property('delimiter');
75 }
76
77 sub listDelimiter {
78 my $obj = shift;
79 return $obj->property('list delimiter');
80 }
81
82 sub hashDelimiter {
83 my $obj = shift;
84 return $obj->property('hash delimiter');
85 }
86
87 sub hereDoc {
88 my $obj = shift;
89 return $obj->property('here doc');
90 }
91
92 sub propertyTypes {
93 my $obj = shift;
94 return $obj->property('property types');
95 }
96
97 sub propertyRegexes {
98 my $obj = shift;
99 return $obj->property('property regexes');
100 }
101
102 sub prototypes {
103 my $obj = shift;
104 return $obj->property('prototypes');
105 }
106
107 sub prototypeRegexes {
108 my $obj = shift;
109 return $obj->property('prototype regexes');
110 }
111
112 1;
113
114 __END__
115
116 =head1 NAME
117
118 Parse::PlainConfig::Settings - Settings Class
119
120 =head1 VERSION
121
122 $Id: lib/Parse/PlainConfig/Settings.pm, 3.02 2016/05/26 13:04:45 acorliss Exp $
123
124 =head1 SYNOPSIS
125
126 use Parse::PlainConfig::Settings;
127
128 my $settings = new Parse::PlainConfig::Settings;
129
130 $ts = $settings->tabStop;
131 $subindent = $settings->subindentation;
132 $comment = $settings->comment;
133 $delim = $settings->delimiter;
134 $ldelim = $settings->listDelimiter;
135 $hdelim = $settings->hashDelimiter;
136 $hdoc = $settings->hereDoc;
137 %propTypes = $settings->propertyTypes;
138 %propRegex = $settings->propertyRegexes;
139 %prototypes = $settings->prototypes;
140 %protoRegex = $settings->prototypeRegexes;
141
142 =head1 DESCRIPTION
143
144 The settings object is created and initialized automatically by
145 L<Parse::PlainConfig>.
146
147 =head1 SUBROUTINES/METHODS
148
149 =head2 tabStop
150
151 $ts = $settings->tabStop;
152
153 Default column width for tab stops.
154
155 =head2 subindentation
156
157 $subindent = $settings->subindentation;
158
159 Default columns for indentation on line continuations.
160
161 =head2 comment
162
163 $comment = $settings->comment;
164
165 Default character sequence for comments.
166
167 =head2 delimiter
168
169 $delim = $settings->delimiter;
170
171 Default character sequence used as the delimiter between the parameter name
172 and the parameter value.
173
174 =head2 listDelimiter
175
176 $ldelim = $settings->listDelimiter;
177
178 Default character sequence used as the delimiter between array elements.
179
180 =head2 hashDelimiter
181
182 $hdelim = $settings->hashDelimiter;
183
184 Default character sequence used as the delimiter between key/value pairs.
185
186 =head2 hereDoc
187
188 $hdoc = $settings->hereDoc;
189
190 Default character sequence used as the token marking the end of here docs.
191
192 =head2 propertyTypes
193
194 %propTypes = $settings->propertyTypes;
195
196 Hash of property names => data types.
197
198 =head2 propertyRegexes
199
200 %propRegex = $settings->propertyRegexes;
201
202 Hash of property names to regular expression to extract data from the line.
203
204 =head2 prototypes
205
206 %prototypes = $settings->prototypes;
207
208 Hash of prototype names => data types.
209
210 =head2 prototypeRegexes
211
212 %protoRegex = $settings->prototypeRegexes;
213
214 Hash of prototype names to regular expression to extract data from the line.
215
216 =head1 DEPENDENCIES
217
218 =over
219
220 =item o
221
222 L<Class::EHierarchy>
223
224 =item o
225
226 L<Paranoid>
227
228 =item o
229
230 L<Paranoid::Debug>
231
232 =item o
233
234 L<Parse::PlainConfig::Constants>
235
236 =back
237
238 =head1 BUGS AND LIMITATIONS
239
240 =head1 AUTHOR
241
242 Arthur Corliss (corliss@digitalmages.com)
243
244 =head1 LICENSE AND COPYRIGHT
245
246 This software is licensed under the same terms as Perl, itself.
247 Please see http://dev.perl.org/licenses/ for more information.
248
249 (c) 2015, Arthur Corliss (corliss@digitalmages.com)
250
+1158
-1458
lib/Parse/PlainConfig.pm less more
0 # Parse::PlainConfig -- Parser for plain-text configuration files
0 # Parse::PlainConfig -- Parsing Engine for Parse::PlainConfig
11 #
2 # (c) 2002 - 2006, Arthur Corliss <corliss@digitalmages.com>,
2 # (c) 2002 - 2016, Arthur Corliss <corliss@digitalmages.com>,
33 #
4 # $Id: PlainConfig.pm,v 2.06 2008/07/07 22:59:35 acorliss Exp $
4 # $Id: lib/Parse/PlainConfig.pm, 3.02 2016/05/26 13:04:45 acorliss Exp $
55 #
6 # This program is free software; you can redistribute it and/or modify
7 # it under the terms of the GNU General Public License as published by
8 # the Free Software Foundation; either version 2 of the License, or
9 # any later version.
10 #
11 # This program is distributed in the hope that it will be useful,
12 # but WITHOUT ANY WARRANTY; without even the implied warranty of
13 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 # GNU General Public License for more details.
15 #
16 # You should have received a copy of the GNU General Public License
17 # along with this program; if not, write to the Free Software
18 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
6 # This software is licensed under the same terms as Perl, itself.
7 # Please see http://dev.perl.org/licenses/ for more information.
198 #
209 #####################################################################
21
22 =head1 NAME
23
24 Parse::PlainConfig - Parser for plain-text configuration files
25
26 =head1 MODULE VERSION
27
28 $Id: PlainConfig.pm,v 2.06 2008/07/07 22:59:35 acorliss Exp $
29
30 =head1 SYNOPSIS
31
32 use Parse::PlainConfig;
33
34 $conf = new Parse::PlainConfig;
35 $conf = Parse::PlainConfig->new(
36 'PARAM_DELIM' => '=',
37 'FILE' => '.myrc',
38 'MAX_BYTES' => 65536,
39 'SMART_PARSER => 1,
40 );
41
42 $conf->property(PARAM_DELIM => '=');
43
44 $rv = $conf->read('myconf.conf');
45 $rv = $conf->read;
46 $rv = $conf->readIfNewer;
47 $conf->write('.myrc', 2);
48
49 $conf->purge;
50
51 @parameters = $conf->parameters;
52 $conf->parameter(FOO => "bar");
53 $value = $conf->parameter(FOO);
54 $conf->describe(FOO => 'This is foo');
55 $conf->coerce("string", qw(FOO BAR));
56
57 @order = $conf->order;
58 $conf->order(@new_order);
59
60 $errstr = Parse::PlainConfig::ERROR;
61
62 $rv = $conf->hasParameter('FOO');
63
64 The following methods are only supported for backwards compatibility reasons.
65 They will likely be removed at some point in the future.
66
67 # Use of the tags DELIM and PURGE are deprecated in favour of
68 # PARAM_DELIM, LIST_DELIM, HASH_DELIM, and AUTOPURGE
69 $conf = Parse::PlainConfig->new(
70 'DELIM' => '=',
71 'PURGE' => 1,
72 );
73
74 # As is the delim method since it works only on the tag delimiter
75 $conf->delim('=');
76
77 # Auto-purge should be enabled/disabled via the property method
78 $conf->purge(1);
79
80 # directives is replaced with parameters
81 @directives = $conf->directives;
82
83 # get/set methods are replaced with a unifed parameter method
84 $field = $conf->get('KEY1');
85 ($field1, $field2) = $conf->get(qw(KEY1 KEY2));
86 $conf->set(KEY1 => 'foo', KEY2 => 'bar');
87
88 # This was just a really bad idea to begin with, plus it's
89 # effective broken at this point (only returns a copy of the
90 # internal hash now, so it's effectively read-only)
91 $hashref = $conf->getRef;
92
93 # This is just a wrapper for the class function
94 $errstr = $conf->error
95
96 =head1 REQUIREMENTS
97
98 =over
99
100 =item *
101
102 Paranoid
103
104 =item *
105
106 Text::ParseWords
107
108 =item *
109
110 Text::Tabs
111
112 =back
113
114 =head1 DESCRIPTION
115
116 Parse::PlainConfig provides OO objects which can parse and generate
117 human-readable configuration files.
118
119 =cut
12010
12111 #####################################################################
12212 #
12616
12717 package Parse::PlainConfig;
12818
19 use 5.008;
20
12921 use strict;
22 use warnings;
13023 use vars qw($VERSION);
24
25 ($VERSION) = ( q$Revision: 3.02 $ =~ /(\d+(?:\.(\d+))+)/sm );
26
27 use Class::EHierarchy qw(:all);
28 use Parse::PlainConfig::Constants qw(:all);
29 use Parse::PlainConfig::Settings;
13130 use Text::ParseWords;
13231 use Text::Tabs;
133 use Carp;
134 use Fcntl qw(:flock);
32 use Fcntl qw(:seek :DEFAULT);
33 use Paranoid;
13534 use Paranoid::Debug;
136 use Paranoid::Filesystem;
137 use Paranoid::Input;
138
139 ($VERSION) = (q$Revision: 2.06 $ =~ /(\d+(?:\.(\d+))+)/);
35 use Paranoid::IO;
36 use Paranoid::IO::Line;
37 use Paranoid::Input qw(:all);
38 use Paranoid::Glob;
39
40 use base qw(Class::EHierarchy);
41
42 use vars qw(@_properties @_methods %_parameters %_prototypes);
14043
14144 #####################################################################
14245 #
14447 #
14548 #####################################################################
14649
147 =head1 FILE SYNTAX
148
149 =head2 TRADITIONAL USAGE
150
151 The plain parser supports the reconstructions of relatively simple data
152 structures. Simple string assignments and one-dimensional arrays and hashes
153 are possible. Below are are various examples of constructs:
154
155 # Scalar assignment
156 FIRST_NAME: Joe
157 LAST_NAME: Blow
158
159 # Array assignment
160 FAVOURITE_COLOURS: red, yellow, green
161 ACCOUNT_NUMBERS: 9956-234-9943211, \
162 2343232-421231445, \
163 004422-03430-0343
164
165 # Hash assignment
166 CARS: crown_vic => 1982, \
167 geo => 1993
168
169 As the example above demonstrates, all lines that begin with a '#' (leading
170 whitespace is allowed) are ignored as comments. if '#" occurs in any other
171 position, it is accepted as part of the passed value. This means that you
172 B<cannot> place comments on the same lines as values.
173
174 All directives and associated values will have both leading and trailing
175 whitespace stripped from them before being stored in the configuration hash.
176 Whitespace is allowed within both.
177
178 In traditional mode (meaning no parameters are set to be coerced into a
179 specific datatype) one must encapsulate list and hash delimiters with
180 quotation marks in order to prevent the string from being split and stored as
181 a list or hash. Quotation marks that are a literal part of the string must be
182 backslashed.
183
184 =head2 SMART PARSER
185
186 The new parser now provides some options to make the file syntax more
187 convenient. You can activate the smart parser by setting B<SMART_PARSER> to a
188 true value during object instantiation or via the B<property> method.
189
190 With the traditional parser you had to backslach the end of all preceding
191 lines if you wanted to split a value into more than one line:
192
193 FOO: This line starts here \
194 and ends here...
195
196 With the smart parser enabled that is no longer necessary as long as the
197 following lines are indented further than the first line:
198
199 FOO: This line starts here
200 and ends here...
201
202 B<Note:> The indentation is compared by byte count with no recognition of
203 tab stops. That means if you indent with spaces on the first line and indent
204 with tabs on the following it may not concantenate those values.
205
206 Another benefit of the smart parser is found when you specify a parameter to
207 be of a specific datatype via the B<COERCE> hash during object instantiation
208 or the B<coerce> method. For instance, the traditional parser requires you to
209 encapsulate strings with quotation marks if they contain list or hash
210 delimiters:
211
212 Quote: "\"It can't be that easy,\" he said."
213
214 Also note how you had to escape quotation marks if they were to be a literal
215 part of the string. With this parameter set to be coerced to a scalar you can
216 simply write:
217
218 Quote: "It can't be that easy," he said.
219
220 Similarly, you don't have to quote hash delimiters in parameters set to be
221 coerced into lists. Quotation marks as part of an element value must be
222 escaped, though, since unescaped quotation marks are assumed to encapsulate
223 strings containing list delimiters you don't want to split on.
224
225 B<Note:> The previous versions of Parse::PlainConfig did not allow the user to
226 set keys like:
227
228 FOO: \
229 bar
230
231 or save empty assignments like
232
233 FOO:
234
235 This is no longer the case. Both are now valid and honoured.
236
237 =head1 SECURITY
238
239 B<WARNING:> This parser will attempt to open what ever you pass to it for a
240 filename as is. If this object is to be used in programs that run with
241 permissions other than the calling user, make sure you sanitize any
242 user-supplied filename strings before passing them to this object.
243
244 This also uses a blocking b<flock> call to open the file for reading and
245 writing.
246
247 =head1 FUNCTIONS
248
249 =head2 Parse::PlainConfig::ERROR
250
251 =cut
252
253 {
254 my $ERROR = '';
255
256 sub ERROR : lvalue { $ERROR };
50 sub _initialize {
51
52 # Purpose: Initialize config object and loads class defaults
53 # Returns: Boolean
54 # Usage: $rv = $obj->_initialize(@args);
55
56 my $obj = shift;
57 my $class = ref $obj;
58 my $rv = 1;
59 my ( $settings, %_globals, %_parameters, %_prototypes );
60
61 pdebug( 'entering w/%s', PPCDLEVEL1, $obj );
62 pIn();
63
64 # Create & adopt the settings object
65 $settings = new Parse::PlainConfig::Settings;
66 $obj->adopt($settings);
67 $settings->alias('settings');
68
69 # Read in class global settings
70 unless ( __PACKAGE__ eq $class ) {
71 pdebug( 'loading globals from %s', PPCDLEVEL2, $class );
72
73 {
74 no strict 'refs';
75
76 %_globals = %{ *{"${class}::_globals"}{HASH} }
77 if defined *{"${class}::_globals"};
78 }
79
80 if ( scalar keys %_globals ) {
81 foreach ( keys %_globals ) {
82 pdebug( 'overriding %s with (%s)',
83 PPCDLEVEL3, $_, $_globals{$_} );
84 $rv = 0 unless $settings->property( $_, $_globals{$_} );
85 }
86 }
87 }
88
89 # Read in class parameters
90 unless ( __PACKAGE__ eq $class ) {
91 pdebug( 'loading parameters from %s', PPCDLEVEL2, $class );
92
93 {
94 no strict 'refs';
95
96 %_parameters = %{ *{"${class}::_parameters"}{HASH} }
97 if defined *{"${class}::_parameters"};
98 }
99
100 if ( scalar keys %_parameters ) {
101 $settings->property( 'property types', %_parameters );
102 foreach ( keys %_parameters ) {
103
104 pdebug( 'creating property %s', PPCDLEVEL3, $_ );
105 unless (
106 _declProp(
107 $obj,
108 CEH_PUB | (
109 $_parameters{$_} == PPC_HDOC
110 ? PPC_SCALAR
111 : $_parameters{$_}
112 ),
113 $_
114 )
115 ) {
116 $rv = 0;
117 last;
118 }
119
120 # Store property regex
121 $settings->store(
122 'property regexes',
123 $_,
124 qr#(\s*)(\Q$_\E)\s*\Q@{[ $settings->delimiter ]}\E\s*(.*)#s
125 );
126 }
127 }
128 }
129
130 # Read in class prototypes
131 unless ( __PACKAGE__ eq $class ) {
132 pdebug( 'loading prototypes from %s', PPCDLEVEL2, $class );
133
134 {
135 no strict 'refs';
136
137 %_prototypes = %{ *{"${class}::_prototypes"}{HASH} }
138 if defined *{"${class}::_prototypes"};
139 }
140
141 if ( scalar keys %_prototypes ) {
142 $settings->property( 'prototypes', %_prototypes );
143 foreach ( keys %_prototypes ) {
144
145 # Store property meta-data
146 $settings->store(
147 'prototype regexes',
148 $_,
149 qr#(\s*)(\Q$_\E)\s+(\S+)\s*\Q@{[ $settings->delimiter ]}\E\s*(.*)#s
150 );
151 }
152 }
153 }
154
155 # Read in defaults from DATA
156 $rv = $obj->parse( $obj->default );
157
158 pOut();
159 pdebug( 'leaving w/rv: %s', PPCDLEVEL1, $rv );
160
161 return $rv;
257162 }
258163
259 =head1 METHODS
164 sub settings {
165
166 # Purpose: Returns object reference to the settings object
167 # Returns: Object reference
168 # Usage: $settings = $obj->settings;
169
170 my $obj = shift;
171
172 return $obj->relative('settings');
173 }
174
175 sub default {
176
177 # Purpose: Returns the DATA block from the calling
178 # Returns: Array
179 # Usage: @lines = $obj->_getData;
180
181 my $obj = shift;
182 my $class = ref $obj;
183 my ( $fn, @chunk, @lines );
184
185 pdebug( 'entering', PPCDLEVEL2 );
186 pIn();
187
188 $class =~ s#::#/#sg;
189 $class .= '.pm';
190 $fn = $INC{$class};
191
192 pdebug( 'attempting to read from %s', PPCDLEVEL3, $fn );
193 if ( popen( $fn, O_RDONLY ) ) {
194
195 # Read in file
196 while ( sip( $fn, @chunk ) and @chunk ) { push @lines, @chunk }
197
198 # Purge all lines prior to __DATA__
199 while ( @lines and $lines[0] !~ /^\s*__DATA__\s*$/s ) {
200 shift @lines;
201 }
202 shift @lines;
203
204 # Purge all lines after __END__
205 if ( @lines and grep /^\s*__END__\s*$/s, @lines ) {
206 while ( @lines and $lines[-1] !~ /^\s*__END__\s*$/s ) {
207 pop @lines;
208 }
209 pop @lines;
210 }
211 pseek( $fn, 0, SEEK_SET );
212 }
213
214 pOut();
215 pdebug( 'leaving w/%s lines', PPCDLEVEL2, scalar @lines );
216
217 return wantarray ? @lines : join '', @lines;
218 }
219
220 sub get {
221
222 # Purpose: Returns the value of the specified parameter
223 # Returns: Scalar/List/Hash
224 # Usage: $val = $obj->get('foo');
225
226 my $obj = shift;
227 my $p = shift;
228 my $valp;
229
230 pdebug( 'entering w/%s', PPCDLEVEL1, $p );
231 pIn();
232
233 if ( defined $p ) {
234 $valp = scalar grep /^\Q$p\E$/s, $obj->propertyNames;
235 }
236 $obj->error(
237 pdebug( 'specified invalid parameter name: %s', PPCDLEVEL1, $p ) )
238 unless $valp;
239
240 pOut();
241 pdebug( 'leaving', PPCDLEVEL1 );
242
243 return $valp ? $obj->property($p) : undef;
244 }
245
246 sub set {
247
248 # Purpose: Assigns the desired values to the specified parameter
249 # Returns: Boolean
250 # Usage: $rv = $obj->set($prop, @values);
251
252 my $obj = shift;
253 my $p = shift;
254 my @vals = @_;
255 my %propTypes = $obj->settings->propertyTypes;
256 my ( $valp, $rv );
257
258 pdebug( 'entering w/(%s)(%s)', PPCDLEVEL1, $p, @vals );
259 pIn();
260
261 if ( defined $p ) {
262 $valp = scalar grep /^\Q$p\E$/s, $obj->propertyNames;
263 }
264 $obj->error(
265 pdebug( 'specified invalid parameter name: %s', PPCDLEVEL1, $p ) )
266 unless $valp;
267
268 if ($valp) {
269 if (@vals) {
270
271 # Set whatever's assigned
272 $rv = $obj->property( $p, @vals );
273 } else {
274
275 # Assume that no values means purge/undef
276 if ( $propTypes{$p} == PPC_SCALAR or $propTypes{$p} == PPC_HDOC )
277 {
278 $rv = $obj->property( $p, undef );
279 } else {
280 $rv = $obj->purge($p);
281 }
282 }
283 }
284
285 pOut();
286 pdebug( 'leaving', PPCDLEVEL1 );
287
288 return $valp ? $rv : undef;
289 }
290
291 sub _snarfBlock (\@\$\$$) {
292
293 # Purpose: Finds and returns the block with the value
294 # string extracted.
295 # Returns: Boolean
296 # Usage: $rv = _snarfBlock(@lines, $val);
297
298 my $lref = shift;
299 my $pref = shift;
300 my $vref = shift;
301 my $settings = shift;
302 my $obj = $settings->parent;
303 my %regex = $settings->propertyRegexes;
304 my %pregex = $settings->prototypeRegexes;
305 my %propTypes = $settings->propertyTypes;
306 my %prototypes = $settings->prototypes;
307 my $subi = $settings->subindentation;
308 my ( $rv, $indent, $prop, $proto, $trailer, $iwidth, $line, $preg );
309
310 pdebug( 'entering', PPCDLEVEL2 );
311 pIn();
312
313 # Match line to a property/prototype declaration
314 #
315 # First try to match against properties
316 foreach ( keys %regex ) {
317 if ( $$lref[0] =~ /^$regex{$_}$/s ) {
318 ( $indent, $prop, $trailer ) = ( $1, $2, $3 );
319 $rv = 1;
320 shift @$lref;
321 last;
322 }
323 }
324 unless ( $rv and defined $prop and length $prop ) {
325 foreach ( keys %pregex ) {
326 if ( $$lref[0] =~ /^$pregex{$_}$/s ) {
327 ( $indent, $proto, $prop, $trailer ) = ( $1, $2, $3, $4 );
328 $rv = 1;
329 shift @$lref;
330 last;
331 }
332 }
333 }
334
335 # Define all prototyped properties
336 if ( defined $proto and length $proto ) {
337 if ( defined $prop and length $prop ) {
338
339 if ( exists $regex{$prop} ) {
340 $obj->error(
341 pdebug(
342 'token (%s) for prototype (%s) attempted to override property',
343 PPCDLEVEL1,
344 $prop,
345 $proto
346 ) );
347 $rv = 0;
348 } else {
349
350 if ( exists $propTypes{$prop} ) {
351
352 # Make sure they haven't been previously defined,
353 # or if they have, they match the same type
354 unless ( $propTypes{$prop} == $prototypes{$proto} ) {
355 $rv = 0;
356 $obj->error(
357 pdebug(
358 'prototype mismatch with previous declaration: %s',
359 PPCDLEVEL1,
360 $proto
361 ) );
362 pdebug( 'current type: %s prototype: %s',
363 PPCDLEVEL1, $propTypes{$prop},
364 $prototypes{$proto} );
365 }
366 } else {
367
368 # Create a new property
369 pdebug( 'creating property based on prototype %s: %s',
370 PPCDLEVEL3, $proto, $prop );
371
372 $rv = _declProp(
373 $obj,
374 CEH_PUB | (
375 $prototypes{$proto} == PPC_HDOC
376 ? PPC_SCALAR
377 : $prototypes{$proto}
378 ),
379 $prop
380 );
381
382 # Record the prop type
383 if ($rv) {
384 $settings->store( 'property types',
385 $prop, $propTypes{$prop} = $prototypes{$proto} );
386 $preg =
387 $settings->retrieve( 'prototype registry',
388 $proto );
389 $preg = [] unless defined $preg;
390 push @$preg, $prop;
391 $settings->store( 'prototype registry',
392 $proto => $preg );
393 } else {
394 $obj->error(
395 pdebug(
396 'failed to declare prototype: %s %s',
397 PPCDLEVEL1, $proto, $prop
398 ) );
399 }
400 }
401 }
402 } else {
403 $obj->error(
404 pdebug(
405 'invalid token used for prototype %s: %s', PPCDLEVEL1,
406 $proto, $prop
407 ) );
408 $rv = 0;
409 }
410 }
411
412 # Grab additional lines as needed
413 if ($rv) {
414
415 if ( $propTypes{$prop} == PPC_HDOC ) {
416
417 # Snarf all lines until we hit the HDOC marker
418 $rv = 0;
419 while (@$lref) {
420 $line = shift @$lref;
421 if ( $line =~ /^\s*\Q@{[ $settings->hereDoc ]}\E\s*$/s ) {
422 $rv = 1;
423 last;
424 } else {
425 $line =~ s/^\s{1,$subi}//s;
426 $trailer .= $line;
427 }
428 }
429
430 # Error out if we never found the marker
431 $obj->error(
432 pdebug( 'failed to find the here doc marker', PPCDLEVEL1 ) )
433 unless $rv;
434
435 } else {
436
437 # All non-HDOCs are handled the same
438 $iwidth = defined $indent ? length $indent : 0;
439 while (@$lref) {
440
441 # We're done if this is a line break
442 last if $$lref[0] =~ /^\s*$/s;
443
444 # We're also done if indentation isn't greater
445 # than the parameter declaration line
446 ($indent) = ( $$lref[0] =~ /^(\s*)/s );
447 last if !defined $indent or $iwidth >= length $indent;
448
449 # Append content to the trailer
450 $line = shift @$lref;
451 $line =~ s/^\s{1,$subi}//s;
452 pchomp($line);
453 $trailer .= $line;
454 }
455 }
456 $trailer =~ s/\s+$//s if defined $trailer;
457 }
458
459 if ($rv) {
460 pchomp($trailer);
461 ( $$pref, $$vref ) = ( $prop, $trailer );
462 pdebug( 'extracted value for %s: %s', PPCDLEVEL3, $prop, $trailer );
463 }
464
465 pOut();
466 pdebug( 'leaving w/rv: %s', PPCDLEVEL2, $rv );
467
468 return $rv;
469 }
470
471 sub _snarfProp {
472
473 # Purpose: Takes the property value and parses according to its type,
474 # then stores it
475 # Returns: Boolean
476 # Usage: $rv = _snarfProp($obj, $prop, $val);
477
478 my $obj = shift;
479 my $prop = shift;
480 my $val = shift;
481 my $settings = $obj->settings;
482 my %propTypes = $settings->propertyTypes;
483 my $ldelim = $settings->listDelimiter;
484 my $hdelim = $settings->hashDelimiter;
485 my $rv = 1;
486 my @elements;
487
488 pdebug( 'entering w/(%s)(%s)', PPCDLEVEL2, $prop, $val );
489 pIn();
490
491 if ( $propTypes{$prop} == PPC_HDOC
492 or $propTypes{$prop} == PPC_SCALAR ) {
493
494 # Here Docs and scalars are stored as-is
495 $obj->property( $prop, $val );
496
497 } else {
498
499 if ( $propTypes{$prop} == PPC_ARRAY ) {
500
501 # Split into a list
502 @elements = quotewords( qr/\Q$ldelim\E/s, 0, $val );
503 foreach (@elements) { s/^\s+//s; s/\s+$//s; }
504
505 } else {
506
507 # Split into a hash
508 @elements =
509 quotewords( qr/(?:\Q$ldelim\E|\Q$hdelim\E)/s, 0, $val );
510 foreach (@elements) { s/^\s+//s; s/\s+$//s; }
511
512 }
513
514 # Store the list value
515 pdebug( 'storing in %s: %s', PPCDLEVEL3, $prop, @elements );
516 $obj->purge($prop);
517 $obj->property( $prop, @elements );
518 }
519
520 pOut();
521 pdebug( 'leaving w/rv: %s', PPCDLEVEL2, $rv );
522
523 return $rv;
524 }
525
526 sub parse {
527
528 # Purpose: Parses passed content and extracts values
529 # Returns: Boolean
530 # Usage: $rv = $obj->parse(@lines);
531
532 my $obj = shift;
533 my @lines = @_;
534 my $settings = $obj->settings;
535 my $delim = $settings->delimiter;
536 my $cre = qr#^\s*\Q@{[ $settings->comment ]}\E#s;
537 my $rv = 1;
538 my ( $text, $prop, $value, $glob );
539
540 pdebug( 'entering', PPCDLEVEL1 );
541 pIn();
542
543 # Some preprocessing of lines
544 if (@lines) {
545 $tabstop = $settings->tabStop;
546 @lines = expand(@lines);
547 foreach (@lines) {
548 $text =
549 ( defined $text and length $text )
550 ? join "\n", $text, split NEWLINE_REGEX, $_
551 : join "\n", split NEWLINE_REGEX, $_;
552 }
553 }
554
555 while (@lines) {
556
557 # Skip comments and empty lines
558 if ( $lines[0] =~ /^$cre/s
559 or $lines[0] =~ /^\s*(?:@{[ NEWLINE_REGEX ]})?$/s ) {
560 shift @lines;
561 next;
562 }
563
564 # Handle "include" statements
565 if ( $lines[0] =~ /^\s*include\s+(.+?)\s*$/s ) {
566 $glob = new Paranoid::Glob globs => [$1];
567 shift @lines;
568 $rv = 0 unless $obj->read($glob);
569 next;
570 }
571
572 # See if we have property block
573 if ( _snarfBlock( @lines, $prop, $value, $settings ) ) {
574
575 # Parse the block
576 $rv = _snarfProp( $obj, $prop, $value );
577
578 } else {
579
580 pdebug( 'discarding invalid input: %s', PPCDLEVEL1, $lines[0] );
581 shift @lines;
582 $rv = 0;
583 }
584 }
585
586 pOut();
587 pdebug( 'leaving w/rv: %s', PPCDLEVEL1, $rv );
588
589 return $rv;
590 }
591
592 sub read {
593
594 # Purpose: Reads the passed file(s)
595 # Returns: Boolean
596 # Usage: $rv = $obj->read($filename);
597
598 my $obj = shift;
599 my $source = shift;
600 my ( $rv, @lines );
601
602 pdebug( 'entering w/%s', PPCDLEVEL1, $source );
603 pIn();
604
605 if (@_) {
606
607 # Work all entries passed if handed a list
608 $rv = $obj->read($source);
609 foreach (@_) { $rv = 0 unless $obj->read($_) }
610
611 } elsif ( ref $source eq '' ) {
612
613 # Treat all non-reference files as filenames
614 if ( slurp( $source, @lines ) ) {
615 $rv = $obj->parse(@lines);
616 pdebug( 'errors parsing %s', PPCDLEVEL1, $source ) unless $rv;
617 } else {
618 $obj->error(
619 pdebug(
620 'failed to read %s: %s', PPCDLEVEL1,
621 $source, Paranoid::ERROR() ) );
622 }
623
624 } elsif ( ref $source eq 'Paranoid::Glob' ) {
625
626 # Handle Paranoid globs specially
627 $rv = 1;
628 foreach (@$source) { $rv = 0 unless $obj->read($_) }
629
630 } else {
631
632 # Handle everything else as if it was a glob
633 if ( slurp( $source, @lines ) ) {
634 $rv = $obj->parse(@lines);
635 pdebug( 'errors parsing %s', PPCDLEVEL1, $source ) unless $rv;
636 } else {
637 $obj->error(
638 pdebug(
639 'failed to read %s: %s', PPCDLEVEL1,
640 $source, Paranoid::ERROR() ) );
641 }
642 }
643
644 pOut();
645 pdebug( 'leaving w/rv: %s', PPCDLEVEL1, $rv );
646
647 return $rv;
648 }
649
650 sub reset {
651
652 # Purpose: Resets configuration state to defaults
653 # Returns: Boolean
654 # Usage: $rv = $obj->reset;
655
656 my $obj = shift;
657 my $settings = $obj->settings;
658 my %propTypes = $settings->propertyTypes;
659 my $rv;
660
661 pdebug( 'entering', PPCDLEVEL1 );
662 pIn();
663
664 # Purge all property values
665 foreach ( keys %propTypes ) {
666 pdebug( 'clearing stored values for %s', PPCDLEVEL2, $_ );
667 if ( $propTypes{$_} == PPC_SCALAR or $propTypes{$_} == PPC_HDOC ) {
668 $obj->property( $_, undef );
669 } else {
670 $obj->purge($_);
671 }
672 }
673 $rv = $obj->parse( $obj->default );
674
675 pOut();
676 pdebug( 'leaving w/rv: %s', PPCDLEVEL1, $rv );
677
678 return $rv;
679 }
680
681 sub prototyped {
682
683 # Purpose: Returns a list of properties that were created with
684 # prototypes
685 # Returns: Array
686 # Usage: @protos = $obj->prototyped;
687
688 my $obj = shift;
689 my $proto = shift;
690 my ( %preg, @prval );
691
692 pdebug( 'entering w/%s', PPCDLEVEL1, $proto );
693 pIn();
694
695 %preg = $obj->settings->property('prototype registry');
696
697 if ( defined $proto and length $proto ) {
698 if ( exists $preg{$proto} ) {
699 @prval = @{ $preg{$proto} };
700 } else {
701 pdebug( 'no prototype properties declared w/%s',
702 PPCDLEVEL2, $proto );
703 }
704 } else {
705 pdebug( 'dumping all declared prototyped properties', PPCDLEVEL2 );
706 foreach ( keys %preg ) { push @prval, @{ $preg{$_} } }
707 }
708
709 pOut();
710 pdebug( 'leaving w/%s', PPCDLEVEL1, @prval );
711
712 return @prval;
713 }
714
715 sub error {
716
717 # Purpose: Sets/gets the last error message
718 # Returns: Scalar/undef
719 # Usage: $errStr = $obj->error;
720 # Usage: $errStr = $obj->error($msg);
721
722 my $obj = shift;
723 my $msg = shift;
724
725 if ( defined $msg ) {
726 $obj->settings->property( 'error', $msg );
727 } else {
728 $msg = $obj->settings->property('error');
729 }
730
731 return $msg;
732 }
733
734 1;
735
736 __END__
737
738 =head1 NAME
739
740 Parse::PlainConfig - Configuration file class
741
742 =head1 VERSION
743
744 $Id: lib/Parse/PlainConfig.pm, 3.02 2016/05/26 13:04:45 acorliss Exp $
745
746 =head1 SYNOPSIS
747
748 =head2 SAMPLE CONFIG CLASS
749
750 package MyConfig;
751
752 use Parse::PlainConfig;
753 use Parse::PlainConfig::Constants;
754 use base qw(Parse::PlainConfig);
755 use vars qw(%_globals %_parameters %_prototypes);
756
757 %_globals = (
758 'comment' => '#',
759 'delimiter' => ':',
760 'list delimiter' => ',',
761 'hash delimiter' => '=>',
762 'subindentation' => 4,
763 'here doc' => 'EOF',
764 );
765 %_parameters = (
766 'daemon ports' => PPC_ARRAY,
767 'banner' => PPC_HDOC,
768 'user' => PPC_SCALAR,
769 'group' => PPC_SCALAR,
770 'database' => PPC_HASH,
771 'acls' => PPC_HASH,
772 );
773 %_prototypes = (
774 'define net' => PPC_ARRAY,
775 );
776
777 1;
778
779 __DATA__
780
781 # This is the default configuration for MyConfig.
782 # Newly created objects based on this class will
783 # inherit the below configuration as default values.
784 #
785 # daemon ports: list of ports to listen on
786 daemon ports: 8888, 9010
787
788 # banner: default banner to display on each connection
789 banner:
790 ******** WARNING ********
791 You are being watched
792 ******** WARNING ********
793 EOF
794
795 user: nobody
796 group: nogroup
797 database:
798 host => localhost,
799 db => mydb,
800 user => dbuser,
801 pass => dbpass
802
803 define net loopback: 127.0.0.1/8, ::1/128
804 define net localnet: 192.168.0.0/24, 192.168.35.0/24
805 define net nonlocal: ! 192.168.0.0/16
806
807 acls: loopback => allow, localnet => allow, nonlocal => deny
808
809 __END__
810
811 =head1 NAME
812
813 normal pod text can be put here...
814
815 =head2 SAMPLE OBJECT USAGE
816
817 $config = new MyConfig;
818
819 print "default user: ", $config->get('user'), "\n";
820 print "default group: ", $config->get('group'), "\n";
821
822 # Override value
823 $config->set('user', 'root');
824
825 # Get config from a file
826 $rv = $config->read($filename);
827
828 # Parse config from in-memory text
829 $rv = $config->parse(@lines);
830
831 # Prototyps are accessed like parameters
832 @localnets = $config->get('localnet');
833
834 # Reset config values back to class defaults
835 $config->reset;
836
837 # Print default config file
838 print $config->default;
839
840 =head1 DESCRIPTION
841
842 B<Parse::PlainConfig> provides a simple way to write a config object class
843 that supports all the basic primitive data types (scalar, array, and hashes)
844 while allowing for arbitrary delimiters, comment characters, and more.
845
846 The use of a B<__DATA__> block to store your default config not only provides
847 for a reference config but a convenient way to set default values for
848 parameters and prototypes. Use of B<__END__> also allows you to append your
849 standard POD text to allow for the creation of man pages documenting your
850 configuration options.
851
852 The parser supports the use of "include {filename|glob}" syntax for splitting
853 configuration parameters amongst multiple config files. Even without it every
854 call to L<read> or L<parse> only applies new settings on top of the existing
855 set, allowing you to aggregate multiple config file parameters into one set of
856 parameters.
857
858 Unlike previous versions of this module B<Parse::PlainConfig> is strictly a
859 parser, not a generator. That functionality never seem to be used enough to
860 be worth maintaining with this upgrade. For backwards compatibility the old
861 Parser/Generator is still included under the new namespace
862 L<Parse::PlainConfig::Legacy>. Updating legacy scripts to use that package
863 name instead should keep everything working.
864
865 B<Parse::PlainConfig> is a subclass of L<Class::EHierarchy>, and all
866 parameters are public properties allowing access to the full set of data-aware
867 methods provided by that module (such as B<store>, B<purge>, B<pop>, B<shift>,
868 and others).
869
870 I/O is also done in a platform-agnostic manner, allowing parsed values to read
871 reliably on any platform regardless of line termination style used to author
872 the config file.
873
874 =head1 SUBCLASSING
875
876 All parsing objects are now subclasses of L<Parse::PlainConfig> tuned for a
877 specific style and a known list of parameters and/or prototypes. This makes
878 coding for config file parsing extremely simple and convenient.
879
880 Control of the parser is performed by setting values in three class hashes:
881
882 =head2 %_globals
883
884 The B<%_globals> hash is primarily used to specify special character sequences
885 the parser will key to identify comments and the various parameters and data
886 types. The following key/value are supported:
887
888 Key Default Description
889 ---------------------------------------------------------------
890 comment # Character(s) used to denote comments
891 delimiter : Parameter/value delimiter
892 list delimiter , Ordinal array values delimiter
893 hash delimiter => Hash values' key/value pair delimiter
894 subindentation 4 Default level of indentation to
895 expect for line continuations
896 here doc EOF Token used for terminating here doc
897 parameter values
898
899 If all of the defaults are acceptable this hash can be omitted entirely.
900
901 Note that the I<subindentation> is merely advisory, any additional level of
902 subindentation on line continuations will work. What this does, however, is
903 trim up to that amount of preceding white space on each line within a
904 here-doc. This allows one to indent blocks of text to maintain the visual
905 flow of the config file, while still allowing the editor the use of all
906 columns in the display.
907
908 =head2 %_parameters
909
910 The B<%_parameters> hash is used to list all of the formal parameters
911 recognized by this config object. All parameters must be one of four data
912 types:
913
914 Type Description
915 ----------------------------------------------------------------
916 PPC_SCALAR Simple strings
917 PPC_ARRAY Arrays/lists
918 PPC_HASH Hashes/Associative arrays
919 PPC_HDOC Essentially a PPC_SCALAR that preserves formatting
920
921 All but B<PPC_HDOC> will trim leading/trailing white space and collapse all
922 lines into a single line for parsing. That means that no string, ordinal
923 value, key, or associative value can have embedded line breaks. You can,
924 however, have delimiter characters as part of any values as long as they are
925 encapusated in quoted text or escaped.
926
927 B<PPC_HDOC> will preserve line breaks, but will trim leading white space on
928 each line up to the value given to B<$_globals{subindentation}>.
929
930 =head2 %_prototypes
931
932 B<%_prototypes> exist to allow for user-defined parameters that fall outside
933 of the formal parameterss in B<%_parameters>. ACLs, for instance, are often
934 of indeterminate number and naming, which is a perfect use-case for
935 prototypes.
936
937 Like parameters prototypes are assigned a data type. Unlike parameters
938 prototypes are assigned types based on a declarative preamble since the the
939 name (or token) is not known in advance.
940
941 To continue with the ACL example we could define a prototype like so:
942
943 %_prototypes = ( 'define acl' => PPC_ARRAY );
944
945 The config editor could then define any number of ACLs:
946
947 define acl loopback 127.0.0.1/8
948 define acl localnet 192.168.0.0/24,192.168.1.0/24
949
950 Once parsed those ACL parameters can then be accessed simply by their unique
951 token:
952
953 @localnets = $config->get('localnet');
954
955 =head1 CONFIG FILE FORMAT RULES
956
957 This module is intended to provide support for parsing human-readable config
958 files, while supporting basic data structures and delimiter flexibility. That
959 said, there are a few basic rules by which the parser operates.
960
961 Note that the use B<__DATA__> and/or B<__END__> blocks are entirely optional.
962
963 =head2 DELIMITERS
964
965 Delimiters must be unique. You cannot use the same character(s) for
966 both list delimiters and hash key/value pair delimiters, for instance. That
967 said, the parser is very forgiving on the use of whitespace around all
968 delimiters, even if one of your delimiters is literally a space.
969
970 Hash and array delimiters can be embedded in elements as long as they're
971 quoted or escaped appropriately. Those elements are split using
972 L<Text::ParseWords>' L<quotewords> function.
973
974 =head2 LINE CONTINUATIONS
975
976 Parameters values may need to be, by necessity, longer than a single line.
977 This is fully supported for all data types. All that is needed that the line
978 continuations be at least one space more indented than the preceding line.
979 Empty lines are considered to be line breaks which terminate the parameter
980 value. Likewise, a line that is indented equal or less than the parameter
981 declaration line implies a new block of content.
982
983 There is one exception to that rule: here docs. If you need to preserve
984 formatting, which can include line breaks, the use of here docs will suck in
985 everything up to the next here doc EOF token. The entire here doc, however,
986 is treated as scalar value for purposes of parameter storage.
987
988 =head2 COMMENTS
989
990 Comments can be any sequence of characters, but must be on a line by
991 themselves. Preceding white space is allowed.
992
993 =head2 PARAMETER NAMES
994
995 Given that parameters are actually formal object properties it could go
996 without saying that each parameter must be uniquely named. Parameters
997 names can include white space or other miscellaneous punctuation.
998
999 =head2 PROTOTYPES
1000
1001 Prototypes allow for the dynamic creation of parameters. There are a few
1002 caveats in their usage, however. Prototypes are specified through a unique
1003 preamble followed by a unique token. Unlike parameter names this token
1004 cannot have embedded white space. But like parameters they are specified by
1005 that unique token (minus the preamble) during L<get> and L<set> operations.
1006
1007 Since these dynamic properties are also formal properties the token must not
1008 be in use as a formal property. In other words, all prototype tokens and
1009 parameter names must be unique as a set.
1010
1011 Parsing errors will be generated if the token occurs as a formal parameter.
1012 It will also be generated if you attempt to redfine a token as a different
1013 type of data structure.
1014
1015 =head1 SUBROUTINES/METHODS
2601016
2611017 =head2 new
2621018
263 $conf = new Parse::PlainConfig;
264 $conf = Parse::PlainConfig->new(
265 'PARAM_DELIM' => '=',
266 'FILE' => '.myrc',
267 'MAX_BYTES' => 65536,
268 'SMART_PARSER => 1,
269 );
270
271 The object constructor can be called with or without arguments. Arguments
272 available for use include:
273
274 Argument Default Purpose
275 =============================================================
276 ORDER [] Specifies specific order of
277 fields to be used while writing
278 FILE undef Filename for read/write ops
279 PARAM_DELIM ':' Field/value delimiter
280 LIST_DELIM ',' List delimiter within field values
281 HASH_DELIM '=>' Hash key/value delimiter within
282 field values
283 AUTOPURGE 0 Autopurge enabled/disabled
284 COERCE {} Field coercion hash
285 DEFAULTS {} Default field values
286 SMART_PARSER 0 Smart parser enabled/disabled
287 MAX_BYTES 16384 Integer denoting maximum bytes
288 to read in any given file
289
290 B<DELIM>, B<PURGE>, and B<FORCE_SCALAR> are still available for backwards
291 compatibility, but may be removed in the future. One should use
292 B<PARAM_DELIM> B<AUTOPURGE>, and B<COERCE> instead.
293
294 B<COERCE> is a hash of field name/data type pairs. If a field is listed in
295 this hash then their values will always be returned in the requested format of
296 either string, list, or hash. Any field coerced to string, for instance, will
297 ignore list and hash delimiters and assume the entire value will always be
298 string value.
299
300 B<DEFAULTS> is a hash of field name/value pairs. This ensures that even if a
301 field is not explicitly set (either in a conf file or programmatically) a
302 default value can still be retrieved.
303
304 B<SMART_PARSER> removes the need to backslash end-of-lines to continue the
305 value onto the next. If the following line is indented further than the tag
306 was it will automatically assume that the next line is a continuation of the
307 previous. It also affects the need to encapsulate coerced datatypes with
308 quotation marks for irrelevant delimiters.
309
310 B<AUTOPURGE> erases all stored parameters and values before reading a file.
311 This does not, however, erase any values set for B<ORDER>.
312
313 =cut
314
315 sub new {
316 my $class = shift;
317 my %init = (
318 CONF => {},
319 ORDER => [],
320 FILE => undef,
321 PARAM_DELIM => ':',
322 LIST_DELIM => ',',
323 HASH_DELIM => '=>',
324 AUTOPURGE => 0,
325 COERCE => {},
326 DEFAULTS => {},
327 SMART_PARSER => 0,
328 PADDING => 2,
329 MAX_BYTES => 16384,
330 MTIME => 0,
331 );
332 my $self = \%init;
333 my %args = @_;
334 my (@keyList, $k, $v, $rv);
335
336 pdebug("entering", 7);
337 pIn();
338
339 bless $self, $class;
340
341 # Assign all the arguments
342 $rv = 1;
343 while ($rv && scalar keys %args) {
344 $k = shift @{[ keys %args ]};
345 $v = $args{$k};
346 delete $args{$k};
347 $rv = $self->property($k, $v);
348 }
349
350 # Return the object reference if no errors occurred during initialization
351 if ($rv) {
352 $v = $rv = $self;
353 } else {
354 $rv = undef;
355 $v = 'undef';
356 }
357
358 pOut();
359 pdebug("leaving w/rv: $v", 7);
360
361 return $self;
362 }
363
364 =head2 property
365
366 $conf->property(PARAM_DELIM => '=');
367
368 This method sets or retrieves the specified property. Please note
369 that this B<overwrites> the current value, even for those properties that are
370 references to lists and hashes.
371
372 If you're using this to set a property it will return a boolean true or false
373 depending on the success of the operation. If you're just retrieving a
374 property it will return the value of the property. If you ask for a
375 nonexistent property it will B<croak>.
376
377 =cut
378
379 sub property ($$;$) {
380 my $self = shift;
381 my @args = @_;
382 my $arg = $args[0];
383 my $val = $args[1];
384 my $ival = defined $val ? $val : 'undef';
385 my $rv = 1;
386
387 croak "Parse::PlainConfig::property was called with an undefined property"
388 unless defined $arg;
389 $arg = 'PARAM_DELIM' if $arg eq 'DELIM';
390 $arg = 'AUTOPURGE' if $arg eq 'PURGE';
391 croak "Parse::PlainConfig::property was called with an unknown property" .
392 "($arg)" unless exists $$self{$arg} or $arg eq 'FORCE_SCALAR';
393
394 pdebug("entering w/($arg)($ival)", 7);
395 pIn();
396
397 pdebug("method is in " . (scalar @args == 2 ? 'set' : 'get') . " mode", 7);
398 $arg = uc($arg);
399
400 # TODO 2008/05/11: properties deprecated, remove FORCE_SCALAR, DELIM, PURGE
401
402 # Validate argument & value
403 if (scalar @args == 2) {
404
405 # Make sure list properties are list references
406 if ($arg =~ /^(?:ORDER|FORCE_SCALAR)$/) {
407 unless (ref($val) eq 'ARRAY') {
408 $rv = 0;
409 ERROR = pdebug("${arg}'s value must be a list reference", 7);
410 }
411
412 # Hash properties are hash references
413 } elsif ($arg =~ /^(?:CONF|COERCE|DEFAULTS)$/) {
414 unless (ref($val) eq 'HASH') {
415 $rv = 0;
416 ERROR = pdebug("${arg}'s value must be a hash reference", 7);
417 }
418
419 # Validate coerced values
420 if ($rv && $arg eq 'COERCE') {
421 foreach (keys %$val) {
422 $ival = defined $$val{$_} ? $$val{$_} : 'undef';
423 ERROR = pdebug("coerced data type ($_: $ival) not a string, " .
424 "list, or hash") and $rv = 0 unless
425 $ival =~ /^(?:string|list|hash)$/;
426 }
427 }
428
429 # And the rest are scalars...
430 # TODO? Validate properties like PADDING that have a concrete list of
431 # TODO? valid values?
432 } elsif (ref($val) ne '') {
433 $rv = 0;
434 ERROR = pdebug("${arg}'s value must be a scalar value", 7);
435 }
436 }
437
438 # Set the value if all's kosher
439 if ($rv) {
440 if (scalar @args == 2) {
441 if ($arg eq 'FORCE_SCALAR') {
442 foreach (@$val) { $$self{COERCE}{$_} = 'string' };
443 } else {
444 $$self{$arg} = $val;
445 }
446 } else {
447 $rv = $$self{$arg};
448 }
449 }
450
451 pOut();
452 pdebug("leaving w/rv: $rv", 7);
453
454 return $rv;
455 }
456
457 =head2 purge
458
459 $conf->purge(1);
460 $conf->purge;
461
462 B<NOTE:> Use of this method to set the purge mode is deprecated and will be
463 removed in the future. For that please use the B<property> method instead.
464
465 This method either (re)sets the auto-purge mode, or performs an immediate manual
466 purge. Auto-purge mode clears the configuration hash each time a
467 configuration file is read, so that the internal configuration data consists
468 solely of what is in that file. If you wanted to combine the settings of
469 multiple files that each may exclusively hold some directives, setting this to
470 'off' will load the combined configuration as you read each file.
471
472 You can still clobber configuration values, of course, if the same directive
473 is defined in multiple files. In that case, the last file's value will be the
474 one stored in the hash.
475
476 This does not clear the B<order> or B<coerce> properties.
477
478 Autopurge mode is disabled by default.
479
480 =cut
481
482 sub purge($$) {
483 my $self = shift;
484 my $arg = shift;
485
486 $arg = 'undef' unless defined $arg;
487 pdebug("entering w/($arg)", 7);
488 pIn();
489
490 # TODO: 2008/05/11: property set invocation deprecated, remove
491
492 if ($arg ne 'undef') {
493 pdebug("setting AUTOPURGE to $arg", 7);
494 $self->property('AUTOPURGE', $arg);
495 } else {
496 pdebug("clearing CONF", 7);
497 $$self{CONF} = {};
498 }
499
500 pOut();
501 pdebug("leaving w/rv: 1", 7);
502
503 return 1;
504 }
1019 $conf = new MyConfig;
1020
1021 This creates a new config object based on the specified config class,
1022 initialized with the defaults stored in B<__DATA__>. No additional arguments
1023 are supported. This will fail if the default config is invalid in any way.
1024
1025 =head2 settings
1026
1027 $settings = $config->settings;
1028
1029 This provides a reference to the engine settings object from which you can
1030 interrogate various settings such as delimiters, etc. The full set of methods
1031 supported by the settings object is documented in
1032 L<Parse::PlainConfig::Settings>.
1033
1034 =head2 default
1035
1036 $text = $config->default;
1037 @lines = $config->default;
1038
1039 This returns the text of the default configuration file embedded in the
1040 B<__DATA__> section of the config class.
1041
1042 =head2 get
1043
1044 $val = $config->get($parameter);
1045 @val = $config->get($parameter);
1046 %val = $config->get($parameter);
1047
1048 This returns the stored value(s) for the specified parameter. It is
1049 essentially the same as using the parent class L<property> method, although
1050 this will not cause the program to L<croak> like L<property> does. It will
1051 L<carp>, instead.
1052
1053 =head2 set
1054
1055 $rv = $config->set($parameter);
1056 $rv = $config->set($parameter, $newval);
1057 $rv = $config->set($parameter, @newval);
1058 $rv = $config->set($parameter, %newval);
1059
1060 This method sets the desired parameter to the newly specified value(s). If no
1061 values are provided it will assume that you wish to set scalars to B<undef> or
1062 empty arrays and hashes.
1063
1064 =head2 parse
1065
1066 $rv = $config->parse($text);
1067 $rv = $config->parse(@lines);
1068
1069 This will parse and set any parameters or protoypes found in the content. It
1070 will return false if any parsing errors are found (spurious text, etc.) but
1071 will extract everything of intelligible value it can.
5051072
5061073 =head2 read
5071074
508 $rv = $conf->read('myconf.conf');
509 $rv = $conf->read;
510
511 The read method is called initially with a filename as the only argument.
512 This causes the parser to read the file and extract all of the configuration
513 directives from it.
514
515 You'll notice that you can also call the read method without an argument.
516 The name of the file read is stored internally, and if already set to a valid
517 value (either by a previous call to B<read> with a filename argument or by
518 setting the B<FILE> property) this will read that file's contents.
519
520 The return value will be one if the file was successfully read and parsed,
521 or zero otherwise. The reason for failure can be read via
522 B<Parse::PlainConfig::ERROR>.
523
524 This function will cause the program to croak if called without a filename
525 ever being defined.
526
527 =cut
528
529 sub read($;$) {
530 my $self = shift;
531 my $file = shift || $$self{FILE};
532 my $purge = $$self{AUTOPURGE};
533 my $rv = 0;
534 my $oldSize = FSZLIMIT;
535 my ($line, @lines);
536
537 croak "Parse::PlainConfig::read called an undefined filename" unless
538 defined $file;
539
540 pdebug("entering w/($file)", 7);
541 pIn();
542
543 # Reset the error string and update the internal filename
544 ERROR = '';
545 $$self{FILE} = $file;
546
547 # Temporarily set the specified size limit
548 FSZLIMIT = $$self{MAX_BYTES};
549
550 # Store the file's current mtime
551 $$self{MTIME} = (stat $file)[9];
552
553 if (slurp($file, \@lines, 1)) {
554
555 # Empty the current config hash and key order
556 $self->purge if $purge;
557
558 # Parse the rc file's lines
559 $rv = $self->_parse(@lines);
560
561 } else {
562 ERROR = Paranoid::ERROR;
563 }
564
565 # Restore old size limit
566 FSZLIMIT = $oldSize;
567
568 pOut();
569 pdebug("leaving w/rv: $rv", 7);
570
571 # Return the result code
572 return $rv;
573 }
574
575 =head2 readIfNewer
576
577 $rv = $conf->readIfNewer;
578
579 This method is used to reread & parse the file only if the mtime appears
580 newer than when last read. If the file was successfully reread or appears to
581 be the same it will return true. Any errors will be stored in
582 B<Parse::PlainConfig::ERROR> and it will return a false value.
583
584 You can determine whether or not the file was read by the true value. If it
585 was re-read it will return 1. If the file appears to be the same age it will
586 return a 2.
587
588 =cut
589
590 sub readIfNewer($) {
591 my $self = shift;
592 my $file = $$self{FILE};
593 my $omtime = $$self{MTIME};
594 my $rv = 0;
595 my $mtime;
596
597 croak "Parse::PlainConfig::readIfNewer called an undefined filename" unless
598 defined $file;
599
600 pdebug("entering w/($file)", 7);
601 pIn();
602
603 # Make sure the file exists and is readable
604 if (-e $file && -r _) {
605
606 # Read if the file appears to be newer
607 $mtime = (stat _)[9];
608 pdebug("current mtime: $mtime last: $omtime", 7);
609 $rv = $mtime > $omtime ? $self->read : 2;
610
611 # Report errors
612 } else {
613 ERROR = "Parse::PlainConfig::readIfNewere: File ($file) does not exist " .
614 "or is not readable!";
615 }
616
617 pOut();
618 pdebug("leaving w/rv: $rv", 7);
619
620 # Return the result code
621 return $rv;
622 }
623
624 =head2 write
625
626 $conf->write('.myrc', 2);
627
628 This method writes the current configuration stored in memory to the specified
629 file, either specified as the first argument, or as stored from an explicit or
630 implicit B<read> call.
631
632 The second argument specifies what kind of whitespace padding, if any, to use
633 with the directive/value delimiter. The following values are recognised:
634
635 Value Meaning
636 ================================================
637 0 No padding (i.e., written as KEY:VALUE)
638 1 Left padding (i.e., written as KEY :VALUE)
639 2 Right padding (i.e., written as KEY: VALUE)
640 3 Full padding (i.e., written as KEY : VALUE)
641
642 Both arguments are optional.
643
644 =cut
645
646 sub write($;$$) {
647 my $self = shift;
648 my $file = shift || $self->{FILE};
649 my $padding = shift;
650 my $conf = $self->{CONF};
651 my $order = $self->{ORDER};
652 my $coerce = $self->{COERCE};
653 my $smart = $self->{SMART_PARSER};
654 my $paramDelim = $self->{PARAM_DELIM};
655 my $hashDelim = $self->{HASH_DELIM};
656 my $listDelim = $self->{LIST_DELIM};
657 my $rv = 0;
658 my $tw = 78;
659 my $delimRegex = qr/(?:\Q$hashDelim\E|\Q$listDelim\E)/;
660 my (@forder, $type, $param, $value, $description, $entry, $out);
661 my ($tmp, $tvalue, $lines);
662
663 # TODO: Implement non-blocking flock support
664 # TODO: Store read padding and/or use PADDING property value
665
666 croak "Parse::PlainConfig::write called an undefined filename" unless
667 defined $file;
668 $padding = 2 unless defined $padding;
669 $tw -= 2 unless $smart;
670
671 pdebug("entering w/($file)($padding)", 7);
672 pIn();
673
674 # Pad the delimiter as specified
675 $paramDelim = $padding == 0 ? $paramDelim : $padding == 1 ? " $paramDelim" :
676 $padding == 2 ? "$paramDelim " : " $paramDelim ";
677 pdebug("PARAM_DELIM w/padding is '$paramDelim'",
678 7);
679
680 # Create a list of parameters for output
681 @forder = @$order;
682 foreach $tmp (sort keys %$conf) { push (@forder, $tmp) unless
683 grep /^\Q$tmp\E$/, @forder };
684 pdebug("order of params to be " .
685 "written:\n\t@forder", 7);
686
687 # Compose the new output
688 $out = '';
689 foreach $param (@forder) {
690
691 # Determine the datatype
692 $value = exists $$conf{$param} ? $$conf{$param}{Value} : '';
693 $description = exists $$conf{$param} ? $$conf{$param}{Description} : '';
694 $type = exists $$coerce{$param} ? $$coerce{$param} :
695 ref($value) eq 'HASH' ? 'hash' : ref($value) eq 'ARRAY' ?
696 'list' : 'string';
697 pdebug("adding $type param ($param)", 7);
698
699 # Append the comments
700 $out .= $description;
701 $out .= "\n" unless $out =~ /\n$/m;
702
703 # Start the new entry with the parameter name and delimiter
704 $entry = "$param$paramDelim";
705
706 # Append the value, taking into consideration the smart parser
707 # and coercion settings
708 if ($type eq 'string') {
709 $tvalue = $value;
710 unless ($smart && exists $$coerce{$param}) {
711 $tvalue =~ s/"/\\"/g;
712 $tvalue = "\"$tvalue\"" if $tvalue =~ /$delimRegex/;
713 }
714 $lines = "$entry$tvalue";
715 } elsif ($type eq 'list') {
716 $tvalue = [ @$value ];
717 foreach (@$tvalue) {
718 s/"/\\"/g;
719 if ($smart && exists $$coerce{$param}) {
720 $_ = "\"$_\"" if /\Q$listDelim\E/;
721 } else {
722 $_ = "\"$_\"" if /$delimRegex/;
723 }
724 }
725 $lines = $entry . join(" $listDelim ", @$tvalue);
726 } else {
727 $tvalue = { %$value };
728 foreach (keys %$tvalue) {
729 $tmp = $_;
730 $tmp =~ s/"/\\"/g;
731 $tmp = "\"$tmp\"" if /$delimRegex/;
732 if ($tmp ne $_) {
733 $$tvalue{$tmp} = $$tvalue{$_};
734 delete $$tvalue{$_};
735 }
736 $$tvalue{$tmp} =~ s/"/\\"/g;
737 $$tvalue{$tmp} = "\"$$tvalue{$tmp}\"" if
738 $$tvalue{$tmp} =~ /$delimRegex/;
739 }
740 $lines = $entry . join(" $listDelim ",
741 map { "$_ $hashDelim $$tvalue{$_}" } sort keys %$tvalue);
742 }
743
744 # wrap the output to the column width and append to the output
745 $out .= _wrap("", "\t", $tw, ($smart ? "\n" : "\\\n"), $lines);
746 $out .= "\n" unless $out =~ /\n$/m;
747 }
748
749 # Attempt to open the file
750 if (detaint($file, 'filename', \$file)) {
751 if (open(RCFILE, "> $file")) {
752
753 # Write the file
754 flock(RCFILE, LOCK_EX);
755 if (print RCFILE $out) {
756 $rv = 1;
757 } else {
758 ERROR = $!;
759 }
760 flock(RCFILE, LOCK_UN);
761 close(RCFILE);
762
763 # Store the new mtime on successful writes
764 $$self{MTIME} = (stat $file)[9] if $rv;
765
766 # Opening the file failed
767 } else {
768 ERROR = "Parse::PlainConfig::write: Error writing file: $!";
769 }
770
771 # Detainting filename failed
772 } else {
773 ERROR = "Parse::PlainConfig::write: illegal characters in filename: " .
774 $file;
775 }
776
777 pOut();
778 pdebug("leaving w/rv: $rv", 7);
779
780 return $rv;
781 }
782
783 =head2 parameters
784
785 @parameters = $conf->parameters;
786
787 This method returns a list of all the names of the directives currently
788 stored in the configuration hash in no particular order.
789
790 =cut
791
792 sub parameters() {
793 my $self = shift;
794 my @parameters = keys %{ $$self{CONF} };
795
796 pdebug("Called Parse::PlainConfig::parameters -- rv: @parameters", 7);
797
798 return @parameters;
799 }
800
801 =head2 parameter
802
803 $value = $conf->parameter('SCALAR1');
804 @values = $conf->parameter('LIST1');
805 %values = $conf->parameter('HASH1');
806 $conf->parameter('SCALAR1', "foo");
807 $conf->parameter('LIST1', [qw(foo bar)]);
808 $conf->parameter('HASH1', { foo => 'bar' });
809
810 This method sets or retrieves the specified parameter. Hash and list values
811 are copied and returned as a list. If the specified parameter is set to be
812 coerced into a specific data type the specified value will be converted to
813 that datatype. This means you can do something like:
814
815 # SCALAR1 will equal "foo , bar , roo" assuming LIST_DELIM is set to ','
816 $conf->coerce(qw(string SCALAR1));
817 $conf->parameter('SCALAR1', [qw(foo bar roo)]);
818
819 # SCALAR1 will equal "foo => bar : roo => ''" assuming HASH_DELIM is set
820 # to '=>' and LIST_DELIM is set to ':'
821 $conf->parameter('SCALAR1', { 'foo' => 'bar', 'roo' => '' });
822
823 In order for conversions to be somewhat predictable (in the case of hashes
824 coerced into other values) hash key/value pairs will be assigned to string
825 or list portions according to the alphabetic sort order of the keys.
826
827 =cut
828
829 sub parameter($$;$) {
830 my $self = shift;
831 my @args = @_;
832 my $param = $args[0];
833 my $value = $args[1];
834 my $ivalue = defined $value ? $value : 'undef';
835 my $conf = $$self{CONF};
836 my $listDelim = $$self{LIST_DELIM};
837 my $hashDelim = $$self{HASH_DELIM};
838 my $paramDelim = $$self{PARAM_DELIM};
839 my $coerceType = exists $$self{COERCE}{$param} ? $$self{COERCE}{$param} :
840 'undef';
841 my $defaults = $$self{DEFAULTS};
842 my $rv = 1;
843 my ($finalValue, @elements);
844
845 # TODO: Consider storing a list/hash padding value as well, for use
846 # TODO: in coercion to string.
847
848 croak "Parse::PlainConfig::parameter was called with an undefined parameter"
849 unless defined $param;
850
851 pdebug("entering w/($param)($ivalue)", 7);
852 pIn();
853
854 if (scalar @args == 2) {
855 pdebug("method in set mode", 7);
856
857 # Create a blank record if it hasn't been defined yet
858 $$conf{$param} = {
859 Value => '',
860 Description => '',
861 } unless exists $$conf{$param};
862
863 # Start processing value assignment
864 if ($coerceType ne 'undef') {
865 pdebug("coercing into $coerceType", 7);
866
867 # Coerce values into strings
868 if ($coerceType eq 'string' && ref($value) ne '') {
869
870 # Convert lists into a string using the list delimiter
871 if (ref($value) eq 'ARRAY') {
872 foreach (@$value) {
873 s/"/\\"/g;
874 $_ = "\"$_\"" if /\Q$listDelim\E/;
875 }
876 $finalValue = join(" $listDelim ", @$value);
877
878 # Convert hashes into a string using the hash & list delimiters
879 } elsif (ref($value) eq 'HASH') {
880 foreach (sort keys %$value) {
881 $ivalue = $_;
882 $ivalue =~ s/"/\\"/g;
883 $ivalue = "\"$ivalue\"" if /(?:\Q$hashDelim\E|\Q$listDelim\E)/;
884 $$value{$_} = '' unless defined $$value{$_};
885 $$value{$_} = "\"$$value{$_}\"" if
886 $$value{$_} =~ /(?:\Q$hashDelim\E|\Q$listDelim\E)/;
887 push(@elements, join(" $hashDelim ", $_, (defined $$value{$_} ?
888 $$value{$_} : ''))) };
889 $finalValue = join(" $listDelim ", @elements);
890
891 # Try to stringify everything else
892 } else {
893 $finalValue = "$value";
894 }
895
896 # Coerce value into a list
897 } elsif ($coerceType eq 'list' && ref($value) ne 'ARRAY') {
898
899 # Convert hashes into a list
900 if (ref($value) eq 'HASH') {
901 $finalValue = [];
902 foreach (sort keys %$value) { push(@$finalValue, $_, $$value{$_}) };
903
904 # Convert strings into a list
905 } elsif (ref($value) eq '') {
906 $self->_parse(split(/\n/m,
907 "$$conf{$param}{Description}\n$param $paramDelim $value"));
908 $finalValue = $$conf{$param}{Value};
909
910 # Stringify everything else and put it into an array
911 } else {
912 $finalValue = [ "$value" ];
913 }
914
915 # Coerce value into a hash
916 } elsif ($coerceType eq 'hash' && ref($value) ne 'HASH') {
917
918 # Convert a list into a hash using every two elements as a
919 # key/value pair
920 if (ref($value) eq 'ARRAY') {
921 push(@$value, '') unless int(scalar @$value / 2) ==
922 scalar @$value / 2;
923 $finalValue = { @$value };
924
925 # Convert strings into a hash
926 } elsif (ref($value) eq '') {
927 $self->_parse(split(/\n/m,
928 "$$conf{$param}{Description}\n$param $paramDelim $value"));
929 $finalValue = $$conf{$param}{Value};
930
931 # Stringify everything else and put the value into the hash key
932 } else {
933 $finalValue = { "$value" => '' };
934 }
935
936 # No coercion is necessary
937 } else {
938 $finalValue = $value;
939 }
940
941 } else {
942 pdebug("no coercion to do", 7);
943 $finalValue = $value;
944 }
945 $$conf{$param}{Value} = $finalValue;
946
947 } else {
948 pdebug("method in retrieve mode", 7);
949 $rv = exists $$conf{$param} ? $$conf{$param}{Value} :
950 exists $$defaults{$param} ? $$defaults{$param} :
951 undef;
952 }
953
954 pOut();
955 pdebug("leaving w/rv: " . (defined $rv ? $rv : 'undef'), 7);
956
957 return ref($rv) eq 'HASH' ? (%$rv) : ref($rv) eq 'ARRAY' ? (@$rv) : $rv;
958 }
959
960 =head2 coerce
961
962 $conf->coerce("string", "FOO", "BAR");
963
964 This method configures the parser to coerce values into the specified
965 datatype (either string, list, or hash) and immediately convert any existing
966 values and store them into that datatype as well.
967
968 =cut
969
970 sub coerce($$@) {
971 my $self = shift;
972 my $type = shift;
973 my $itype = defined $type ? $type : 'undef';
974 my @params = @_;
975
976 croak "Parse::PlainConfig::coerce called with an invalid datatype ($itype)"
977 unless $itype =~ /^(?:string|list|hash)$/;
978 croak "Parse::PlainConfig::coerce called with no named parameters" unless
979 @params;
980
981 pdebug("entering w/($itype)(@params)", 7);
982 pIn();
983
984 foreach (@params) {
985 $$self{COERCE}{$_} = $type;
986 $self->parameter($_, $$self{CONF}{$_}{Value}) if exists $$self{CONF}{$_};
987 }
988
989 pOut();
990 pdebug("leaving w/rv: 1", 7);
991 }
992
993 =head2 describe
994
995 $conf->describe(KEY1 => 'This is foo', KEY2 => 'This is bar');
996
997 The describe method takes any number of key/description pairs which will be
998 used as comments preceding the directives in any newly written conf file. You
999 are responsible for prepending a comment character to each line, as well as
1000 splitting along your desired text width.
1001
1002 =cut
1003
1004 sub describe($@) {
1005 my $self = shift;
1006 my $conf = $$self{CONF};
1007 my $coerce = $$self{COERCE};
1008 my %new = (@_);
1009
1010 pdebug("entering", 7);
1011 pIn();
1012
1013 # TODO: Consider allowing comment tags to be specified
1014
1015 # TODO: Consider line splitting and comment tag prepending where
1016 # TODO: it's not already done.
1017
1018 foreach (keys %new) {
1019 pdebug("$_ is described as '$new{$_}'", 7);
1020 unless (exists $$conf{$_}) {
1021 $$conf{$_} = {};
1022 if (exists $$coerce{$_}) {
1023 $$conf{$_}{Value} = $$coerce{$_} eq 'list' ? [] :
1024 $$coerce{$_} eq 'hash' ? {} : '';
1025 } else {
1026 $$conf{$_}{Value} = '';
1027 }
1028 }
1029 $$conf{$_}{Description} = $new{$_};
1030 }
1031
1032 pOut();
1033 pdebug("leaving w/rv: 1", 7);
1034
1035 return 1;
1036 }
1037
1038 =head2 order
1039
1040 @order = $conf->order;
1041 $conf->order(@new_order);
1042
1043 This method returns the current order of the configuration directives as read
1044 from the file. If called with a list as an argument, it will set the
1045 directive order with that list. This method is probably of limited use except
1046 when you wish to control the order in which directives are written in new conf
1047 files.
1048
1049 Please note that if there are more directives than are present in this list,
1050 those extra keys will still be included in the new file, but will appear in
1051 alphabetically sorted order at the end, after all of the keys present in the
1052 list.
1053
1054 =cut
1055
1056 sub order($@) {
1057 my $self = shift;
1058 my $order = $$self{ORDER};
1059 my @new = (@_);
1060
1061 pdebug("entering w/(@new)", 7);
1062
1063 @$order = (@new) if scalar @new;
1064
1065 pdebug("leaving w/rv: @$order", 7);
1066
1067 return @$order;
1068 }
1069
1070
1071 sub _parse($@) {
1072 # Parses the passed list of lines and extracts comments, fields, and
1073 # values from them, storing them in the CONF hash.
1074 #
1075 # Usage: $self->_parse(@lines);
1076
1077 my $self = shift;
1078 my $conf = $$self{CONF};
1079 my $order = $$self{ORDER};
1080 my $smart = $$self{SMART_PARSER};
1081 my $tagDelim = $$self{PARAM_DELIM};
1082 my $hashDelim = $$self{HASH_DELIM};
1083 my $listDelim = $$self{LIST_DELIM};
1084 my @lines = @_;
1085 my $rv = 1;
1086 my ($i, $line, $comment, $entry, $field, $value);
1087 my ($indentation, $data);
1088
1089 # Make sure some of the properties are sane
1090 croak "LIST_DELIM and HASH_DELIM cannot be the same character sequence!\n"
1091 unless $$self{LIST_DELIM} ne $$self{HASH_DELIM};
1092
1093 pdebug("entering", 8);
1094 pIn();
1095
1096 # Flatten lines using an explicit backslash
1097 for ($i = 0; $i <= $#lines ; $i++) {
1098
1099 # Let's disable uninitialized warnings since there's a few
1100 # places here we really don't care
1101 no warnings 'uninitialized';
1102
1103 if ($lines[$i] =~ /\\\s*$/) {
1104 pdebug("joining lines @{[ $i + 1 ]} " . "\& @{[ $i + 2 ]}", 8);
1105
1106 # Lop off the trailing whitespace and backslash, preserving
1107 # only one space on the assumption that if it's there it's a
1108 # natural word break.
1109 $lines[$i] =~ s/(\s)?\s*\\\s*$/$1/;
1110
1111 # Concatenate the following line (if there is one) after stripping
1112 # off preceding whitespace
1113 if ($i < $#lines) {
1114 $lines[$i + 1] =~ s/^\s+//;
1115 $lines[$i] .= $lines[$i + 1];
1116 splice(@lines, $i + 1, 1);
1117 --$i;
1118 }
1119 }
1120 }
1121
1122 local *saveEntry = sub {
1123 # Saves the extracted data into the conf hash and resets
1124 # the vars.
1125
1126 my ($type);
1127
1128 ($field, $value) =
1129 ($entry =~ /^\s*([^$tagDelim]+?)\s*\Q$tagDelim\E\s*(.*)$/);
1130 pdebug("saving data:\n\t($field: $value)", 8);
1131
1132 # Get the field data type from COERCE if set
1133 if (exists $$self{COERCE}{$field}) {
1134 $type = $$self{COERCE}{$field};
1135
1136 # Otherwise, autodetect
1137 } else {
1138 $type = scalar quotewords(qr/\s*\Q$hashDelim\E\s*/, 0, $value) > 1 ?
1139 'hash' : scalar quotewords(qr/\s*\Q$listDelim\E\s*/, 0, $value) > 1 ?
1140 'list' : 'scalar';
1141 }
1142 pdebug("detected type of $field is $type",
1143 8);
1144
1145 # We'll apply quotewords to scalar values only if the smart parser is
1146 # not being used or if we're not coercing all values into scalar for
1147 # this field.
1148 #
1149 # I hate having to do this but I was an idiot in the previous versions
1150 # and this is necessary for backwards compatibility.
1151 if ($type eq 'scalar') {
1152 $value = join('', quotewords(qr/\s*\Q$listDelim\E\s*/, 0, $value))
1153 unless $smart && exists $$self{COERCE}{$field} &&
1154 $$self{COERCE}{$field} eq 'scalar';
1155 } elsif ($type eq 'hash') {
1156 $value = { quotewords(qr/\s*(?:\Q$hashDelim\E|\Q$listDelim\E)\s*/, 0,
1157 $value) };
1158 } elsif ($type eq 'list') {
1159 $value = [ quotewords(qr/\s*\Q$listDelim\E\s*/, 0, $value) ];
1160 }
1161
1162 # Create the parameter record
1163 $$conf{$field} = {};
1164 $$conf{$field}{Value} = $value;
1165 $$conf{$field}{Description} = $comment;
1166 push(@$order, $field) unless grep /^\Q$field\E$/, @$order;
1167 $comment = $entry = '';
1168 };
1169
1170 # Process lines
1171 $comment = $entry = '';
1172 while (defined ($line = shift @lines)) {
1173
1174 # Grab comments and blank lines
1175 if ($line =~ /^\s*(?:#.*)?$/) {
1176 pdebug("comment/blank line:\n\t$line", 9);
1177
1178 # First save previous entries if $entry has content
1179 &saveEntry() and $i = 0 if length($entry);
1180
1181 # Save the comments
1182 $comment = length($comment) > 0 ? "$comment$line\n" : "$line\n";
1183
1184 # Grab configuration lines
1185 } else {
1186
1187 # If this is the first line of a new entry and there's no
1188 # PARAM_DELIM skip the line -- something must be wrong.
1189 #
1190 # TODO: Error out/raise exception
1191 pdebug("skipping spurious text:\n\t$line",
1192 9) and next unless length($entry) || $line =~ /\Q$tagDelim\E/;
1193
1194 # Grab indentation characters and line content
1195 ($indentation, $data) = ($line =~ /^(\s*)(.+)$/);
1196 pdebug("data line:\n\t$data", 9);
1197
1198 # If smart parsing is enabled
1199 if ($smart) {
1200
1201 # If there's current content
1202 if (length($entry)) {
1203
1204 # If new indentation is greater than original indentation
1205 # we concatenate the lines as a continuation
1206 if (length($indentation) > $i) {
1207 $entry .= $data;
1208
1209 # Otherwise we treat this a a new entry, so we save the old
1210 # and store the current
1211 } else {
1212 &saveEntry();
1213 ($i, $entry) = (length($indentation) , $data);
1214 }
1215
1216 # No current content, so just store the current data and continue
1217 # processing
1218 } else {
1219 ($i, $entry) = (length($indentation) , $data);
1220 }
1221
1222 # Smart parsing is disabled, so treat every line as a new entry
1223 } else {
1224 $entry = $data;
1225 &saveEntry();
1226 }
1227 }
1228 }
1229 &saveEntry() if length($entry);
1230
1231 pOut();
1232 pdebug("leaving w/rv: $rv", 8);
1233
1234 return $rv;
1235 }
1236
1237 sub _wrap($$$$$) {
1238 # Parses the passed line of text and inserts indentation and line breaks as
1239 # specified.
1240 #
1241 # Usage: $paragraph = _wrap(...);
1242
1243 my $firstIndent = shift;
1244 my $subIndent = shift;
1245 my $textWidth = shift;
1246 my $lineBreak = shift;
1247 my $paragraph = shift;
1248 my (@lines, $segment, $output);
1249
1250 pdebug("entering w/($firstIndent)" .
1251 "($subIndent)($textWidth)($lineBreak):\n\t$paragraph", 8);
1252 pIn();
1253
1254 # Expand tabs in everything -- sorry everyone
1255 ($firstIndent) = expand($firstIndent);
1256 ($subIndent) = expand($subIndent);
1257 $paragraph = expand("$firstIndent$paragraph");
1258
1259 $lines[0] = '';
1260 while (length($paragraph) > 0) {
1261 ($segment) = ($paragraph =~ /^(\s*\S+\s?)/);
1262
1263 # If the segment will fit appended to the current line, concatenate it
1264 if (length($segment) <= $textWidth - length($lines[$#lines])) {
1265 $lines[$#lines] .= $segment;
1266
1267 # Or, if the segment will fit into the next line, add it
1268 } elsif (length($segment) <= $textWidth - length($subIndent)) {
1269 $lines[$#lines] .= $lineBreak;
1270 push(@lines, "$subIndent$segment");
1271
1272 # Else, split on the text width
1273 } else {
1274 $segment = $#lines == 0 ? substr($paragraph, 0, $textWidth) :
1275 substr($paragraph, 0, $textWidth - length($subIndent));
1276 if (length($segment) > $textWidth - length($lines[$#lines])) {
1277 $lines[$#lines] .= $lineBreak;
1278 push(@lines, ($#lines == 0 ? $segment : "$subIndent$segment"));
1279 } else {
1280 $lines[$#lines] .= $segment;
1281 }
1282 }
1283 $paragraph =~ s/^.{@{[length($segment)]}}//;
1284 }
1285 $lines[$#lines] .= "\n";
1286
1287 $output = join('', @lines);
1288
1289 pOut();
1290 pdebug("leaving w/rv:\n$output", 8);
1291
1292 return $output;
1293 }
1294
1295 =head2 hasParameter
1296
1297 $rv = $conf->hasParameter('FOO');
1298
1299 This function allows you to see if a parameter has been defined or has a
1300 default set for it. Returns a boolean value.
1301
1302 =cut
1303
1304 sub hasParameter($$) {
1305 my $self = shift;
1306 my $param = shift;
1307 my $rv = 0;
1308 my @params = (
1309 keys %{ $self->{CONF} },
1310 keys %{ $self->{DEFAULTS} },
1311 );
1312
1313 croak "Parse::PlainConfig::parameter was called with an undefined parameter"
1314 unless defined $param;
1315
1316 pdebug("entering w/($param)", 7);
1317 pIn();
1318
1319 $rv = scalar grep /^\Q$param\E$/, @params;
1320
1321 pOut();
1322 pdebug("leaving w/rv: $rv", 7);
1323
1324 return $rv;
1325 }
1326
1327 ##################################
1328 # Backwards compatibilty graveyard
1329 ##################################
1330
1331 =head1 DEPRECATED METHODS
1332
1333 =head2 delim
1334
1335 $conf->delim('=');
1336
1337 This method gets and/or sets the parameter name/value delimiter to be used in the
1338 conf files. The default delimiter is ':'. This can be multiple characters.
1339
1340 =cut
1341
1342 sub delim {
1343 # TODO 2008/05/11: deprecated, remove
1344
1345 my $self = shift;
1346 my $delim = shift || $self->property('PARAM_DELIM');
1347
1348 pdebug("Called Parse::PlainConfig::delim -- calling property", 7);
1349 $self->property(PARAM_DELIM => $delim);
1350
1351 return $delim;
1352 }
1353
1354 =head2 directives
1355
1356 @directives = $conf->directives;
1357
1358 This method returns a list of all the names of the directives currently
1359 stored in the configuration hash in no particular order.
1360
1361 =cut
1362
1363 sub directives {
1364 # TODO 2008/05/11: deprecated, remove
1365
1366 my $self = shift;
1367
1368 pdebug("Called Parse::PlainConfig::directives -- calling parameters", 7);
1369
1370 return $self->parameters;
1371 }
1372
1373 =head2 get
1374
1375 $field = $conf->get('KEY1');
1376 ($field1, $field2) = $conf->get(qw(KEY1 KEY2));
1377
1378 The get method takes any number of directives to retrieve, and returns them.
1379 Please note that both hash and list values are passed by reference. In order
1380 to protect the internal state information, the contents of either reference is
1381 merely a copy of what is in the configuration object's hash. This will B<not>
1382 pass you a reference to data stored internally in the object. Because of
1383 this, it's perfectly safe for you to shift off values from a list as you
1384 process it, and so on.
1385
1386 =cut
1387
1388 sub get {
1389 # TODO 2008/05/11: deprecated, remove
1390
1391 my $self = shift;
1392 my $conf = $$self{CONF};
1393 my @fields = @_;
1394 my (@results, $ref);
1395
1396 croak "Parse::PlainConfig::get called with no fields" unless @fields;
1397
1398 pdebug("Entering Parse::PlainConfig::get", 7);
1399 pIn();
1400
1401 # Loop through each requested field
1402 foreach (@fields) {
1403 $ref = exists $$conf{$_}{Value} ? $$conf{$_}{Value} : undef;
1404 $ref = { %$ref } if ref($ref) eq 'HASH';
1405 $ref = [ @$ref ] if ref($ref) eq 'ARRAY';
1406 push(@results, $ref);
1407 }
1408
1409 pOut();
1410 pdebug("Leaving Parse::PlainConfig::get w/rv: @results", 7);
1411
1412 # Return the values
1413 return (scalar @fields > 1) ? @results : $results[0];
1414 }
1415
1416 =head2 set
1417
1418 $conf->set(KEY1 => 'foo', KEY2 => 'bar');
1419
1420 The set method takes any number of directive/value pairs and copies them into
1421 the internal configuration hash.
1422
1423 =cut
1424
1425 sub set {
1426 # TODO 2008/05/11: deprecated, remove
1427
1428 my $self = shift;
1429 my $conf = $$self{CONF};
1430 my %new = (@_);
1431
1432 foreach (keys %new) { $self->parameter($_, $new{$_}) };
1433
1434 return 1;
1435 }
1436
1437 =head2 get_ref
1438
1439 $href = $conf->get_ref
1440
1441 B<Note>: This used to give you a reference to the internal configuration hash
1442 so you could manipulate it directly. It now only gives you a B<copy> of the
1443 internal hash (actually, it's reconstructed has to make it look like the old
1444 data structure). In short, any changes you make to this hash B<will be lost>.
1445
1446 =cut
1447
1448 sub get_ref {
1449 # TODO 2008/05/11: deprecated, remove
1450
1451 my $self = shift;
1452 my $href = {};
1453
1454 foreach (keys %{ $$self{CONF} }) { $$href{$_} = $$self{CONF}{$_}{Value} };
1455 pdebug("Called Parse::PlainConfig::get_ref -- rv: $href", 7);
1456
1457 return $href;
1458 }
1075 $rv = $config->read($filename);
1076 $rv = $config->read(@files);
1077 $rv = $config->read($pglob);
1078 $rv = $config->read(*fh);
1079
1080 This method will attempt to read every file passed to it, whether it be passed
1081 by file name, file handle, L<Paranoid::Glob>, or objec reference support I/O
1082 functions. Fair warning: this does observe file locking semantics (L<flock>)
1083 and it will close any file handles passed to it after consuming the content.
1084
1085 Also note that this method uses L<Paranoid::IO::Line>, which implements
1086 protections against memory-utilization attacks. You may need to adjust the
1087 following parameters depending on the size of your config files:
1088
1089 use Paranoid::IO qw(PIOMAXFSIZE PIOBLKSIZE);
1090 use Paranoid::IO qw(PIOMAXLNSIZE);
1091
1092 # Adjust read block size for performance
1093 PIOBLKSIZE = 16 * 1024;
1094
1095 # Allow file sizes up to 128KB
1096 PIOMAXFSIZE = 128 * 1024;
1097
1098 # Allow individual lines to be 4KB long
1099 PIOMAXLNSIZE = 4 * 1024;
1100
1101 =head2 reset
1102
1103 $rv = $config->reset;
1104
1105 This method purges the contents of all parameters and prototypes, then applies
1106 the default settings as found in B<__DATA__>.
1107
1108 =head2 prototyped
1109
1110 @protos = $config->prototyped;
1111 @protos = $config->prototyped($preamble);
1112
1113 This method returns a list of properties that were defined as the result of
1114 prototypes. With no arguments it returns all properties that were defined.
1115 With an argument it returns only those properties that were defined by that
1116 specific prototype preamble.
14591117
14601118 =head2 error
14611119
1462 warn $conf->error;
1463
1464 This method returns a zero-length string if no errors were registered with the
1465 last operation, or a text message describing the error.
1466
1467 =cut
1468
1469 sub error {
1470 # TODO 2008/05/11: deprecated, remove
1471
1472 my $errStr = ERROR;
1473
1474 pdebug("Called Parse::PlainConfig::error -- rv: $errStr", 7);
1475
1476 return $errStr;
1477 }
1478
1479 1;
1480
1481 =head1 DIAGNOSTICS
1120 $errStr = $config->error;
1121
1122 Returns the last error that occured. Note that this isn't reset between
1123 method invocations.
1124
1125 =head1 DEPENDENCIES
1126
1127 =over
1128
1129 =item o
1130
1131 L<Class::EHierarchy>
1132
1133 =item o
1134
1135 L<Fcntl>
1136
1137 =item o
1138
1139 L<Paranoid>
1140
1141 =item o
1142
1143 L<Paranoid::Debug>
1144
1145 =item o
1146
1147 L<Paranoid::Glob>
1148
1149 =item o
1150
1151 L<Paranoid::IO>
1152
1153 =item o
1154
1155 L<Paranoid::IO::Line>
1156
1157 =item o
1158
1159 L<Paranoid::Input>
1160
1161 =item o
1162
1163 L<Parse::PlainConfig::Constants>
1164
1165 =item o
1166
1167 L<Parse::PlainConfig::Settings>
1168
1169 =item o
1170
1171 L<Text::ParseWords>
1172
1173 =item o
1174
1175 L<Text::Tabs>
1176
1177 =back
1178
1179 =head1 DIAGNOSTICS
14821180
14831181 Through the use of B<Paranoid::Debug> this module will produce internal
14841182 diagnostic output to STDERR. It begins logging at log level 7. To enable
1485 debugging output please see the pod for Paranoid::Debug.
1486
1487 =head1 HISTORY
1488
1489 2002/01/18: Original public release (v1.1)
1490 2006/05/26: Complete rewrite (v2.0)
1491
1492 =head1 AUTHOR/COPYRIGHT
1493
1494 (c) 2002 Arthur Corliss (corliss@digitalmages.com)
1495
1496 =cut
1497
1183 debugging output please see the pod for L<Paranoid::Debug>.
1184
1185 =head1 BUGS AND LIMITATIONS
1186
1187 =head1 AUTHOR
1188
1189 Arthur Corliss (corliss@digitalmages.com)
1190
1191 =head1 LICENSE AND COPYRIGHT
1192
1193 This software is licensed under the same terms as Perl, itself.
1194 Please see http://dev.perl.org/licenses/ for more information.
1195
1196 (c) 2002 - 2016, Arthur Corliss (corliss@digitalmages.com)
1197
+0
-24
t/01_ini.t less more
0 # 01_ini.t
1 #
2 # Tests for proper loading of the module
3
4 use Parse::PlainConfig;
5
6 $|++;
7 print "1..2\n";
8
9 my $test = 1;
10
11 # 1 load
12 my $conf = new Parse::PlainConfig;
13 ref($conf) eq "Parse::PlainConfig" ? print "ok $test\n" :
14 print "not ok $test\n";
15 $test++;
16
17 # 2 alternate load
18 $conf = Parse::PlainConfig->new('PARAM_DELIM' => '=', PADDING => 1);
19 ref($conf) eq "Parse::PlainConfig" ? print "ok $test\n" :
20 print "not ok $test\n";
21 $test++;
22
23 # end 01_ini.t
+0
-74
t/02_property.t less more
0 # 02_property.t
1 #
2 # Tests the property method
3
4 use Parse::PlainConfig;
5
6 $|++;
7 print "1..17\n";
8
9 my $test = 1;
10 my $conf = new Parse::PlainConfig;
11 my @valScalar = qw(PARAM_DELIM LIST_DELIM HASH_DELIM AUTOPURGE SMART_PARSER
12 PADDING FILE MTIME);
13 my $rv;
14
15 # Test invalid properties
16 #
17 # 1 Calling FOO should cause it to croak
18 $rv = eval { $conf->property(FOO => "bar") };
19 ! defined $rv ? print "ok $test\n" : print "not ok $test\n";
20 $test++;
21
22 # 2 Call a scalar property with a non-scalar value
23 $rv = $conf->property(PARAM_DELIM => []);
24 ! $rv ? print "ok $test\n" : print "not ok $test\n";
25 $test++;
26
27 # 3 Call a list property with a non-list reference value
28 $rv = $conf->property(ORDER => "foo");
29 ! $rv ? print "ok $test\n" : print "not ok $test\n";
30 $test++;
31
32 # 4 Call a hash property with a non-hash reference value
33 $rv = $conf->property(COERCE => []);
34 ! $rv ? print "ok $test\n" : print "not ok $test\n";
35 $test++;
36
37 # 5 Try to coerce a parameter to an unknown data type
38 $rv = $conf->property(COERCE => { FOO => 'bar' });
39 ! $rv ? print "ok $test\n" : print "not ok $test\n";
40 $test++;
41
42 # Test valid properties
43 #
44 # 6 .. 13 Scalar value properties
45 foreach (@valScalar) {
46 $rv = $conf->property($_ => "foo");
47 $rv ? print "ok $test\n" : print "not ok $test\n";
48 $test++;
49 }
50
51 # 14 List value properties
52 $rv = $conf->property(ORDER => [qw(FOO BAR ROO)]);
53 $rv ? print "ok $test\n" : print "not ok $test\n";
54 $test++;
55
56 # 15 Hash value properties
57 $rv = $conf->property(COERCE => {
58 FOO => 'list',
59 BAR => 'string',
60 ROO => 'hash',
61 });
62 $rv ? print "ok $test\n" : print "not ok $test\n";
63 $test++;
64
65 # 16 .. 17 MAX_BYTES
66 $rv = $conf->property(MAX_BYTES => 512);
67 $rv ? print "ok $test\n" : print "not ok $test\n";
68 $test++;
69 $rv = $conf->read("./t/testrc");
70 ! $rv ? print "ok $test\n" : print "not ok $test\n";
71 $test++;
72
73 # end 02_property.t
+0
-25
t/03_read.t less more
0 # 03_read.t
1 #
2 # Tests the read method
3
4 use Parse::PlainConfig;
5
6 $|++;
7 print "1..2\n";
8
9 my $test = 1;
10 my $testrc = "./t/testrc";
11 my $conf = new Parse::PlainConfig;
12
13 # 1 Read failure (non-existent file)
14 $rv = $conf->read("${testrc}-1");
15 ! $rv ? print "ok $test\n" : print "not ok $test\n";
16 $test++;
17
18 # 2 Read test
19 $rv = $conf->read($testrc);
20 $rv && grep(/^SCALAR 1$/, $conf->parameters) ? print "ok $test\n" :
21 print "not ok $test\n";
22 $test++;
23
24 # end 03_read.t
+0
-30
t/04_parameters.t less more
0 # 04_parameters.t
1 #
2 # Tests the parameters method
3
4 use Parse::PlainConfig;
5
6 $|++;
7 print "1..7\n";
8
9 my $test = 1;
10 my $testrc = "./t/testrc";
11 my $conf = Parse::PlainConfig->new(FILE => $testrc);
12 my @test = ("SCALAR 1", "SCALAR 2", "SCALAR 3", "LIST 1", "LIST 2",
13 "HASH 1");
14 my @params;
15
16 # 1 Make sure parameters have been read
17 $conf->read;
18 @params = $conf->parameters;
19 scalar @params > 1 ? print "ok $test\n" : print "not ok $test\n";
20 $test++;
21
22 # 2 .. 7 Make sure specific parameters are present
23 foreach (@test) {
24 grep(/^\Q$_\E$/, @params) ? print "ok $test\n" :
25 print "not ok $test\n";
26 $test++;
27 }
28
29 # end 04_parameters.t
+0
-27
t/05_purge.t less more
0 # 05_purge.t
1 #
2 # Tests the purge method
3
4 use Parse::PlainConfig;
5
6 $|++;
7 print "1..2\n";
8
9 my $test = 1;
10 my $testrc = "./t/testrc";
11 my $conf = Parse::PlainConfig->new(FILE => $testrc);
12 my @params;
13
14 # 1 Make sure parameters have been read
15 $conf->read;
16 @params = $conf->parameters;
17 scalar @params > 1 ? print "ok $test\n" : print "not ok $test\n";
18 $test++;
19
20 # 2 Purge and make sure there are no parameters
21 $conf->purge;
22 @params = $conf->parameters;
23 scalar @params == 0 ? print "ok $test\n" : print "not ok $test\n";
24 $test++;
25
26 # end 05_purge.t
+0
-98
t/06_scalar.t less more
0 # 06_scalar.t
1 #
2 # Tests for proper extraction of scalar values
3
4 use Parse::PlainConfig;
5
6 $|++;
7 print "1..13\n";
8
9 my $test = 1;
10 my $rcfile = './t/testrc';
11 my $conf = Parse::PlainConfig->new(FILE => $rcfile);
12
13 # First series with smart parser off
14 #
15 # 1 scalar 1
16 $conf->read($rcfile);
17 $conf->parameter("SCALAR 1") eq "value1" ? print "ok $test\n" :
18 print "not ok $test\n";
19 $test++;
20
21 # 2 scalar 2
22 $conf->parameter("SCALAR 2") eq "these, are, all one => value" ?
23 print "ok $test\n" : print "not ok $test\n";
24 $test++;
25
26 # 3 scalar 3
27 $conf->parameter("SCALAR 3") eq "this is a continued line." ?
28 print "ok $test\n" : print "not ok $test\n";
29 $test++;
30
31 # 4 scalar 4
32 $conf->parameter("SCALAR 4") eq
33 "ASDFKAS234123098ASDFA9082341ASDFIO23489078907SFASDF8A972" ?
34 print "ok $test\n" : print "not ok $test\n";
35 $test++;
36
37 # Second series with smart parser on
38 #
39 # 5 scalar 1
40 $conf->property(SMART_PARSER => 1);
41 $conf->property(AUTOPURGE => 1);
42 $conf->read("${rcfile}_smart");
43 $conf->parameter("SCALAR 1") eq "value1" ? print "ok $test\n" :
44 print "not ok $test\n";
45 $test++;
46
47 # 6 scalar 2
48 $conf->parameter("SCALAR 2") eq "these, are, all one => value" ?
49 print "ok $test\n" : print "not ok $test\n";
50 $test++;
51
52 # 7 scalar 3
53 $conf->parameter("SCALAR 3") eq "this is a continued line." ?
54 print "ok $test\n" : print "not ok $test\n";
55 $test++;
56
57 # 8 scalar 4
58 $conf->parameter("SCALAR 4") eq
59 "ASDFKAS234123098ASDFA9082341ASDFIO23489078907SFASDF8A972" ?
60 print "ok $test\n" : print "not ok $test\n";
61 $test++;
62
63 # 9 scalar 2 with scalar coercion set and smart parsing
64 $conf->coerce("string", "SCALAR 2");
65 $conf->read;
66 $conf->parameter("SCALAR 2") eq '"these, are, all one => value"' ?
67 print "ok $test\n" : print "not ok $test\n";
68 $test++;
69
70 # Set tests
71 #
72 # 10 new scalar 1
73 $conf->parameter("NEW SCALAR 1", "this is new");
74 $conf->parameter("NEW SCALAR 1") eq "this is new" ?
75 print "ok $test\n" : print "not ok $test\n";
76 $test++;
77
78 # 11 new scalar 2 with coercion set
79 $conf->coerce("string", "NEW SCALAR 2");
80 $conf->parameter("NEW SCALAR 2", "this is also new");
81 $conf->parameter("NEW SCALAR 2") eq "this is also new" ?
82 print "ok $test\n" : print "not ok $test\n";
83 $test++;
84
85 # 12 new scalar 2 with list value
86 $conf->parameter("NEW SCALAR 2", [qw(this is new again)]);
87 $conf->parameter("NEW SCALAR 2") eq "this , is , new , again" ?
88 print "ok $test\n" : print "not ok $test\n";
89 $test++;
90
91 # 13 new scalar 2 with hash value
92 $conf->parameter("NEW SCALAR 2", {qw(this is new indeed)});
93 $conf->parameter("NEW SCALAR 2") eq "new => indeed , this => is" ?
94 print "ok $test\n" : print "not ok $test\n";
95 $test++;
96
97 # end 06_scalar.t
+0
-81
t/07_list.t less more
0 # 07_list.t
1 #
2 # Tests for proper extraction of scalar values
3
4 use Parse::PlainConfig;
5
6 $|++;
7 print "1..10\n";
8
9 my $test = 1;
10 my $rcfile = './t/testrc';
11 my $conf = Parse::PlainConfig->new(FILE => $rcfile);
12
13 # First series with smart parser off
14 #
15 # 1 list 1
16 $conf->read($rcfile);
17 ($conf->parameter("LIST 1"))[2] eq "value3" ? print "ok $test\n" :
18 print "not ok $test\n";
19 $test++;
20
21 # 2 list 2
22 ($conf->parameter("LIST 2"))[1] eq "two, parts" ? print "ok $test\n" :
23 print "not ok $test\n";
24 $test++;
25
26 # 3 list 3
27 ($conf->parameter("LIST 3"))[2] eq "two => parts" ? print "ok $test\n" :
28 print "not ok $test\n";
29 $test++;
30
31 # Second series with smart parser on
32 #
33 # 4 list 1
34 $conf->property(SMART_PARSER => 1);
35 $conf->property(AUTOPURGE => 1);
36 $conf->read("${rcfile}_smart");
37 ($conf->parameter("LIST 1"))[2] eq "value3" ? print "ok $test\n" :
38 print "not ok $test\n";
39 $test++;
40
41 # 5 list 2
42 ($conf->parameter("LIST 2"))[1] eq "two, parts" ? print "ok $test\n" :
43 print "not ok $test\n";
44 $test++;
45
46 # 6 list 3 with list coercion set and smart parsing
47 $conf->coerce("list", "LIST 3");
48 $conf->read;
49 ($conf->parameter("LIST 3"))[2] eq "two => parts" ? print "ok $test\n" :
50 print "not ok $test\n";
51 $test++;
52
53 # Set tests
54 #
55 # 7 new list 1
56 $conf->parameter("NEW LIST 1", [qw(this is a new list)]);
57 ($conf->parameter("NEW LIST 1"))[2] eq "a" ? print "ok $test\n" :
58 print "not ok $test\n";
59 $test++;
60
61 # 8 new list 2 with coercion set
62 $conf->coerce("list", "NEW LIST 2");
63 $conf->parameter("NEW LIST 2", [qw(this is a new list)]);
64 ($conf->parameter("NEW LIST 2"))[2] eq "a" ? print "ok $test\n" :
65 print "not ok $test\n";
66 $test++;
67
68 # 9 new list 2 with string value
69 $conf->parameter("NEW LIST 2", "this is new");
70 ($conf->parameter("NEW LIST 2"))[0] eq "this is new" ? print "ok $test\n" :
71 print "not ok $test\n";
72 $test++;
73
74 # 10 new list 2 with hash value
75 $conf->parameter("NEW LIST 2", { 'this' => 'is', 'also' => 'new' });
76 ($conf->parameter("NEW LIST 2"))[2] eq "this" ? print "ok $test\n" :
77 print "not ok $test\n";
78 $test++;
79
80 # end 07_list.t
+0
-52
t/08_hash.t less more
0 # 08_hash.t
1 #
2 # Tests for proper extraction of hash values
3
4 use Parse::PlainConfig;
5
6 $|++;
7 print "1..6\n";
8
9 my $test = 1;
10 my $rcfile = './t/testrc';
11 my $conf = Parse::PlainConfig->new(FILE => $rcfile);
12 $conf->read($rcfile);
13 my %hash = ( $conf->parameter("HASH 1") );
14
15 # 1 hash 1
16 $hash{two} eq "2" ? print "ok $test\n" : print "not ok $test\n";
17 $test++;
18
19 # 2 hash 1
20 $hash{three} eq "Three for Me! 3 => 2" ? print "ok $test\n" :
21 print "not ok $test\n";
22 $test++;
23
24 # Set tests
25 #
26 # 3 new hash 1
27 $conf->parameter('NEW HASH 1', { 'foo' => 'bar' });
28 %hash = $conf->parameter('NEW HASH 1');
29 $hash{foo} eq "bar" ? print "ok $test\n" : print "not ok $test\n";
30 $test++;
31
32 # 4 new hash 2 with coercion set
33 $conf->coerce('hash', 'NEW HASH 2');
34 $conf->parameter('NEW HASH 2', { 'foo' => 'bar' });
35 %hash = $conf->parameter('NEW HASH 2');
36 $hash{foo} eq "bar" ? print "ok $test\n" : print "not ok $test\n";
37 $test++;
38
39 # 5 new hash 2 with string value
40 $conf->parameter('NEW HASH 2', "bar => foo");
41 %hash = $conf->parameter('NEW HASH 2');
42 $hash{bar} eq "foo" ? print "ok $test\n" : print "not ok $test\n";
43 $test++;
44
45 # 6 new hash 2 with list value
46 $conf->parameter('NEW HASH 2', [qw(foo bar roo)]);
47 %hash = $conf->parameter('NEW HASH 2');
48 $hash{foo} eq "bar" ? print "ok $test\n" : print "not ok $test\n";
49 $test++;
50
51 # end 08_hash.t
+0
-49
t/09_coerce.t less more
0 # 09_coerce.t
1 #
2 # Tests coerce method
3
4 use Parse::PlainConfig;
5
6 $|++;
7 print "1..5\n";
8
9 my $test = 1;
10 my $rcfile = './t/testrc_smart';
11 my $conf = Parse::PlainConfig->new(
12 FILE => $rcfile,
13 SMART_PARSER => 1,
14 COERCE => {
15 'SCALAR 2' => 'string',
16 'LIST 3' => 'list',
17 },
18 );
19 $conf->read;
20 my %hash;
21
22 # 1 scalar 2
23 $conf->parameter("SCALAR 2") eq '"these, are, all one => value"' ?
24 print "ok $test\n" : print "not ok $test\n";
25 $test++;
26
27 # 2 list 3
28 ($conf->parameter("LIST 3"))[2] eq "two => parts" ? print "ok $test\n" :
29 print "not ok $test\n";
30 $test++;
31
32 # 3 coerce list 1 into string
33 $conf->coerce('string', 'LIST 1');
34 $conf->parameter("LIST 1") eq "value1 , value2 , value3" ?
35 print "ok $test\n" : print "not ok $test\n";
36 $test++;
37
38 # 4 .. 5 coerce scalar 2 into a hash
39 $conf->parameter('SCALAR 2',
40 ($conf->parameter('SCALAR 2') =~ /^"(.*)"$/)[0]);
41 $conf->coerce('hash', 'SCALAR 2');
42 %hash = ( $conf->parameter('SCALAR 2') );
43 $hash{"these"} eq 'are' ? print "ok $test\n" : print "not ok $test\n";
44 $test++;
45 $hash{"all one"} eq 'value' ? print "ok $test\n" : print "not ok $test\n";
46 $test++;
47
48 # end 09_coerce.t
+0
-60
t/10_write.t less more
0 # 10_write.t
1 #
2 # Tests the write method
3
4 use Parse::PlainConfig;
5
6 $|++;
7 print "1..6\n";
8
9 my $test = 1;
10 my $conf = new Parse::PlainConfig;
11 my $nconf = new Parse::PlainConfig;
12 my $testrc = "./t/testrc";
13 $conf->coerce('string', 'SCALAR 5');
14 $conf->read($testrc);
15
16 # 1 write w/o smart
17 $rv = $conf->write("${testrc}_write");
18 $rv ? print "ok $test\n" : print "not ok $test\n";
19 $test++;
20
21 # 2 verify worthiness of new file
22 $rv = $nconf->read("${testrc}_write");
23 $rv ? print "ok $test\n" : print "not ok $test\n";
24 $test++;
25
26 # 3 compare values in both
27 $conf->parameter('SCALAR 5') eq $nconf->parameter('SCALAR 5') ?
28 print "ok $test\n" : print "not ok $test\n";
29 unlink "${testrc}_write";
30 $test++;
31
32 # 4 write w/smart
33 $conf->property("SMART_PARSER", 1);
34 $conf->coerce('string', 'SCALAR 1', 'SCALAR 2', 'SCALAR 3', 'SCALAR 4',
35 'SCALAR 5');
36 $conf->coerce('list', 'LIST 1', 'LIST 2', 'LIST 3');
37 $conf->coerce('hash', 'HASH 1');
38 $rv = $conf->write("${testrc}_write_smart");
39 $rv ? print "ok $test\n" : print "not ok $test\n";
40 $test++;
41
42 # 5 verify worthiness of new file
43 $nconf->purge;
44 $nconf->property("SMART_PARSER", 1);
45 $nconf->coerce('string', 'SCALAR 1', 'SCALAR 2', 'SCALAR 3', 'SCALAR 4',
46 'SCALAR 5');
47 $nconf->coerce('list', 'LIST 1', 'LIST 2', 'LIST 3');
48 $nconf->coerce('hash', 'HASH 1');
49 $nconf->read("${testrc}_write_smart");
50 $rv ? print "ok $test\n" : print "not ok $test\n";
51 $test++;
52
53 # 6 compare values in both
54 $conf->parameter('SCALAR 5') eq $nconf->parameter('SCALAR 5') ?
55 print "ok $test\n" : print "not ok $test\n";
56 unlink "${testrc}_write_smart";
57 $test++;
58
59 # end 10_write.t
+0
-39
t/11_order.t less more
0 # 11_order.t
1 #
2 # Tests the order method
3
4 use Parse::PlainConfig;
5
6 $|++;
7 print "1..2\n";
8
9 my $test = 1;
10 my $conf = new Parse::PlainConfig;
11 my $nconf = new Parse::PlainConfig;
12 my $testrc = "./t/testrc";
13 $conf->coerce('string', 'SCALAR 5');
14 $conf->read($testrc);
15
16 # 1 change order and write w/smart
17 $conf->property("SMART_PARSER", 1);
18 $conf->coerce('string', 'SCALAR 1', 'SCALAR 2', 'SCALAR 3', 'SCALAR 4',
19 'SCALAR 5');
20 $conf->coerce('list', 'LIST 1', 'LIST 2', 'LIST 3');
21 $conf->coerce('hash', 'HASH 1');
22 $conf->order('HASH 1', 'LIST 3', 'SCALAR 5');
23 $rv = $conf->write("${testrc}_order");
24 $rv ? print "ok $test\n" : print "not ok $test\n";
25 $test++;
26
27 # 2 read and compare order
28 $nconf->property("SMART_PARSER", 1);
29 $nconf->coerce('string', 'SCALAR 1', 'SCALAR 2', 'SCALAR 3', 'SCALAR 4',
30 'SCALAR 5');
31 $nconf->coerce('list', 'LIST 1', 'LIST 2', 'LIST 3');
32 $nconf->coerce('hash', 'HASH 1');
33 $nconf->read("${testrc}_order");
34 ($nconf->order)[0] eq 'HASH 1' ? print "ok $test\n" : print "not ok $test\n";
35 unlink "${testrc}_order";
36 $test++;
37
38 # end 11_order.t
+0
-39
t/12_purge.t less more
0 # 12_purge.t
1 #
2 # Tests the purge and autopurge functionality
3
4 use Parse::PlainConfig;
5
6 $|++;
7 print "1..5\n";
8
9 my $test = 1;
10 my $conf = new Parse::PlainConfig;
11 my $testrc = "./t/testrc";
12 my ($val, $val2, @params);
13 $conf->read($testrc);
14
15 # 1 & 2 Test purge
16 @params = $conf->parameters();
17 @params ? print "ok $test\n" : print "not ok $test\n";
18 $test++;
19 $conf->purge();
20 @params = $conf->parameters();
21 @params ? print "not ok $test\n" : print "ok $test\n";
22 $test++;
23
24 # 3 .. 5 Test autopurge
25 $conf->read;
26 $conf->parameter("FOO" => "BAR");
27 @params = $conf->parameters();
28 grep(/^FOO$/, @params) ? print "ok $test\n" : print "not ok $test\n";
29 $test++;
30 $conf->property("AUTOPURGE" => 1);
31 $conf->read;
32 @params = $conf->parameters();
33 grep(/^FOO$/, @params) ? print "not ok $test\n" : print "ok $test\n";
34 $test++;
35 @params ? print "ok $test\n" : print "not ok $test\n";
36 $test++;
37
38 # end 12_purge.t
+0
-60
t/13_readIfNewer.t less more
0 # 13_readIfNewer.t
1 #
2 # Tests the readIfNewer method
3
4 use Parse::PlainConfig;
5
6 $|++;
7 print "1..8\n";
8
9 my $test = 1;
10 my $conf1 = new Parse::PlainConfig;
11 my $conf2 = new Parse::PlainConfig;
12 my $testrc = "./t/testrc-tmp";
13 my $rv;
14
15 # 1 & 2 Load & write to temp file
16 $rv = $conf1->read("./t/testrc");
17 $rv ? print "ok $test\n" : print "not ok $test\n";
18 $test++;
19 $rv = $conf1->write($testrc);
20 $rv ? print "ok $test\n" : print "not ok $test\n";
21 $test++;
22 $conf1->property(FILE => $testrc);
23
24 # 3 Load conf2 w/temp file
25 $rv = $conf2->read($testrc);
26 $rv ? print "ok $test\n" : print "not ok $test\n";
27 $test++;
28
29 # 4 Write new value w/conf1
30 sleep 3;
31 $conf1->parameter("FOO" => "BAR");
32 $rv = $conf1->write;
33 $rv ? print "ok $test\n" : print "not ok $test\n";
34 $test++;
35
36 # 5 Reread w/conf2
37 sleep 3;
38 $rv = $conf2->readIfNewer;
39 $rv == 1 ? print "ok $test\n" : print "not ok $test\n";
40 $test++;
41
42 # 6 Make sure new value is there
43 grep(/^FOO$/, $conf2->parameters) ? print "ok $test\n" :
44 print "not ok $test\n";
45 $test++;
46
47 # 7 Reread once more
48 sleep 1;
49 $rv = $conf2->readIfNewer;
50 $rv == 2 ? print "ok $test\n" : print "not ok $test\n";
51 $test++;
52
53 # 8 Unlink file and reread
54 unlink $testrc;
55 $rv = $conf2->readIfNewer;
56 $rv ? print "not ok $test\n" : print "ok $test\n";
57 $test++;
58
59 # end 13_readIfNewer.t
+0
-69
t/14_compat.t less more
0 # 14_compat.t
1 #
2 # Tests the traditional usage for backwards compatibility
3
4 use Parse::PlainConfig;
5
6 $|++;
7 print "1..9\n";
8
9 my $test = 1;
10 my $conf = new Parse::PlainConfig;
11 my $testrc = "./t/testrc";
12 my ($val, $val2);
13 $conf->read($testrc);
14
15 # 1 Test purge property set
16 $conf->purge(1);
17 $conf->property("AUTOPURGE") ? print "ok $test\n" :
18 print "not ok $test\n";
19 $test++;
20
21 # 2 Test FORCE_SCALAR property
22 $conf->property("FORCE_SCALAR", ["SCALAR 1", "SCALAR 2"]);
23 $val = $conf->property("COERCE");
24 $$val{'SCALAR 1'} eq 'string' ? print "ok $test\n" : print "not ok $test\n";
25 $test++;
26
27 # 3 Test DELIM property
28 $conf->property("DELIM", "**");
29 $val = $conf->property("PARAM_DELIM");
30 $val eq "**" ? print "ok $test\n" : print "not ok $test\n";
31 $test++;
32
33 # 4 Test delim method
34 $conf->delim("=");
35 $val = $conf->property("PARAM_DELIM");
36 $val eq "=" ? print "ok $test\n" : print "not ok $test\n";
37 $test++;
38
39 # 5 Test get method
40 $val = $conf->get('SCALAR 1');
41 $val eq "value1" ? print "ok $test\n" : print "not ok $test\n";
42 $test++;
43
44 # 6 Test get method again
45 ($val, $val2) = $conf->get('SCALAR 1', 'SCALAR 3');
46 $val2 eq "this is a continued line." ? print "ok $test\n" :
47 print "not ok $test\n";
48 $test++;
49
50 # 7 Test set method
51 $conf->set('SCALAR 1', 'value one');
52 $val = $conf->get('SCALAR 1');
53 $val eq 'value one' ? print "ok $test\n" : print "not ok $test\n";
54 $test++;
55
56 # 8 Test get_ref method
57 $val = $conf->get_ref;
58 $val2 = $$val{'SCALAR 1'};
59 $val2 eq 'value one' ? print "ok $test\n" : print "not ok $test\n";
60 $test++;
61
62 # 9 Test error method
63 Parse::PlainConfig::ERROR = 'ouch!';
64 $val = $conf->error;
65 $val eq 'ouch!' ? print "ok $test\n" : print "not ok $test\n";
66 $test++;
67
68 # end 14_compat.t
+0
-30
t/15_defaults.t less more
0 # 15_defaults.t
1 #
2 # Test the defaults capability
3
4 use Parse::PlainConfig;
5
6 $|++;
7 print "1..2\n";
8
9 my $test = 1;
10 my $conf = new Parse::PlainConfig;
11 my $testrc = "./t/testrc";
12 my ($val, $val2);
13 $conf->read($testrc);
14 $conf->property(DEFAULTS =>
15 {
16 NOT_PRESENT => 1,
17 });
18
19 # 1 Test defaults
20 $val = $conf->parameter('NOT_PRESENT');
21 $val == 1 ? print "ok $test\n" : print "not ok $test\n";
22 $test++;
23
24 # 2 Test present key
25 $val = $conf->parameter('SCALAR 1');
26 $val eq 'value1' ? print "ok $test\n" : print "not ok $test\n";
27 $test++;
28
29 # end 15_defaults.t
+0
-35
t/16_hasParameter.t less more
0 # 16_hasParameter.t
1 #
2 # Tests the traditional usage for backwards compatibility
3
4 use Parse::PlainConfig;
5
6 $|++;
7 print "1..3\n";
8
9 my $test = 1;
10 my $conf = new Parse::PlainConfig;
11 my $testrc = "./t/testrc";
12 my ($val, $val2);
13 $conf->read($testrc);
14 $conf->property(DEFAULTS =>
15 {
16 NOT_PRESENT => 1,
17 });
18
19 # 1 Test key that exists in the defaults hash
20 $rv = $conf->hasParameter('NOT_PRESENT');
21 $rv ? print "ok $test\n" : print "not ok $test\n";
22 $test++;
23
24 # 2 Test present key
25 $rv = $conf->hasParameter('SCALAR 1');
26 $rv ? print "ok $test\n" : print "not ok $test\n";
27 $test++;
28
29 # 3 Test invalid key
30 $rv = ! $conf->hasParameter('NOT_THERE');
31 $rv ? print "ok $test\n" : print "not ok $test\n";
32 $test++;
33
34 # end 16_hasParameter.t
+9
-0
t/98_pod_coverage.t less more
0 #!/usr/bin/perl -T
1 use Paranoid;
2 use Test::More;
3 eval "use Test::Pod::Coverage 1.00";
4 plan skip_all => "Test::Pod::Coverage 1.00 required for testing POD coverage" if $@;
5 all_pod_coverage_ok(
6 { private => [ qr/^_/, qr/^[DI]LEVEL$/, qr/^PDINDIGNORED$/ ] }
7 );
8
+7
-0
t/99_pod.t less more
0 #!/usr/bin/perl -T
1 use Paranoid;
2 use Test::More;
3 psecureEnv('/bin:/usr/bin:/usr/ccs/bin:/usr/local/bin');
4 eval "use Test::Pod 1.00";
5 plan skip_all => "Test::Pod 1.00 required for testing POD" if $@;
6 all_pod_files_ok();
+2
-0
t/lib/01_include_me.conf less more
0 // Let's actually assign something to nodefault
1 nodefault := whoops!
+64
-0
t/lib/BadConf.pm less more
0 package BadConf;
1
2 use strict;
3 use warnings;
4
5 use Parse::PlainConfig;
6 use Parse::PlainConfig::Constants;
7 use base qw(Parse::PlainConfig);
8 use vars qw(%_globals %_parameters %_prototypes);
9
10 %_globals = (
11 comment => ';',
12 'delimiter' => ' ',
13 'list delimiter' => ':',
14 'hash delimiter' => '@',
15 'subindentation' => 4,
16 );
17
18 %_parameters = (
19 'admin email' => PPC_SCALAR,
20 'db' => PPC_HASH,
21 'hosts' => PPC_ARRAY,
22 'note' => PPC_HDOC,
23 'nodefault' => PPC_SCALAR,
24 );
25
26 %_prototypes = (
27 'declare acl' => PPC_ARRAY,
28 'declare foo' => PPC_SCALAR
29 );
30
31 1;
32
33 __DATA__
34 ; This is a sample conf file that not only provides a reference config but
35 ; also supplies the default values of any parameter not explicitly set below.
36 ;
37 ; admin email: email address of the admin
38 admin email root@localhost
39
40 ; db: host, database, username, and password for database access
41 db
42 host @ localhost :
43 database @ sample.db :
44 username @ dbuser :
45 password @ dbpass
46
47 ; hosts: list of hosts to monitor
48 hosts localhost:host1.foo.com:host1.bar.com
49
50 note This is a note, but not a
51 very long note. With this odd
52 selection of delimiters it looks
53 even more weird.
54 EOF
55
56 ; Let's throw some random ACLs out there
57 declare acl loopback 127.0.0.1:localhost
58 declare acl localnet 192.168.0.0/24:192.168.35.0/24
59
60 ; nodefault is just a scalar parameter that has no default setting
61
62 ; Let's throw in some non-existent parameters
63 foo bar
+62
-0
t/lib/CStyle.pm less more
0 package CStyle;
1
2 use strict;
3 use warnings;
4
5 use Parse::PlainConfig;
6 use Parse::PlainConfig::Constants;
7 use base qw(Parse::PlainConfig);
8 use vars qw(%_globals %_parameters %_prototypes);
9
10 %_globals = (
11 comment => '//',
12 'delimiter' => ':=',
13 'list delimiter' => ',',
14 'hash delimiter' => '->',
15 'subindentation' => 4,
16 );
17
18 %_parameters = (
19 'admin email' => PPC_SCALAR,
20 'db' => PPC_HASH,
21 'hosts' => PPC_ARRAY,
22 'note' => PPC_HDOC,
23 'nodefault' => PPC_SCALAR,
24 );
25
26 %_prototypes = (
27 'declare acl' => PPC_ARRAY,
28 'declare foo' => PPC_SCALAR
29 );
30
31 1;
32
33 __DATA__
34 // Okay, this is only a little C'ish, I'm mixing my language memes a
35 // wee bit.
36 //
37 // admin email: email address of the admin
38 admin email := root@localhost
39
40 // db: host, database, username, and password for database access
41 db :=
42 host->localhost,
43 database->sample.db,
44 username->dbuser,
45 password->dbpass
46
47 // hosts: list of hosts to monitor
48 hosts := localhost,host1.foo.com,host1.bar.com
49
50 note := This is a note, but not a
51 very long note. With this odd
52 selection of delimiters it looks
53 even more weird.
54 EOF
55
56 // Let's throw some random ACLs out there
57 declare acl loopback := 127.0.0.1,localhost
58 declare acl localnet := 192.168.0.0/24,192.168.35.0/24
59
60 // nodefault is just a scalar parameter that has no default setting
61
+69
-0
t/lib/MyConf.pm less more
0 package MyConf;
1
2 use strict;
3 use warnings;
4
5 use Parse::PlainConfig;
6 use Parse::PlainConfig::Constants;
7 use base qw(Parse::PlainConfig);
8 use vars qw(%_globals %_parameters %_prototypes);
9
10 %_globals = (
11 comment => ';',
12 'delimiter' => ' ',
13 'list delimiter' => ':',
14 'hash delimiter' => '@',
15 'subindentation' => 4,
16 );
17
18 %_parameters = (
19 'admin email' => PPC_SCALAR,
20 'db' => PPC_HASH,
21 'hosts' => PPC_ARRAY,
22 'note' => PPC_HDOC,
23 'nodefault' => PPC_SCALAR,
24 );
25
26 %_prototypes = (
27 'declare acl' => PPC_ARRAY,
28 'declare foo' => PPC_SCALAR
29 );
30
31 1;
32
33 __DATA__
34 ; This is a sample conf file that not only provides a reference config but
35 ; also supplies the default values of any parameter not explicitly set below.
36 ;
37 ; admin email: email address of the admin
38 admin email root@localhost
39
40 ; db: host, database, username, and password for database access
41 db
42 host @ localhost :
43 database @ sample.db :
44 username @ dbuser :
45 password @ dbpass
46
47 ; hosts: list of hosts to monitor
48 hosts localhost:host1.foo.com:host1.bar.com
49
50 note This is a note, but not a
51 very long note. With this odd
52 selection of delimiters it looks
53 even more weird.
54 EOF
55
56 ; Let's throw some random ACLs out there
57 declare acl loopback 127.0.0.1:localhost
58 declare acl localnet 192.168.0.0/24:192.168.35.0/24
59
60 ; nodefault is just a scalar parameter that has no default setting
61
62 declare foo bar roo
63
64 __END__
65
66 =head2 POD STARTS HERE
67
68 Arg!
+33
-0
t/lib/NoDefaults.pm less more
0 package NoDefaults;
1
2 use strict;
3 use warnings;
4
5 use Parse::PlainConfig;
6 use Parse::PlainConfig::Constants;
7 use base qw(Parse::PlainConfig);
8 use vars qw(%_globals %_parameters %_prototypes);
9
10 %_globals = (
11 comment => ';',
12 'delimiter' => ' ',
13 'list delimiter' => ':',
14 'hash delimiter' => '@',
15 'subindentation' => 4,
16 );
17
18 %_parameters = (
19 'admin email' => PPC_SCALAR,
20 'db' => PPC_HASH,
21 'hosts' => PPC_ARRAY,
22 'note' => PPC_HDOC,
23 'nodefault' => PPC_SCALAR,
24 );
25
26 %_prototypes = (
27 'declare acl' => PPC_ARRAY,
28 'declare foo' => PPC_SCALAR
29 );
30
31 1;
32
+26
-0
t/lib/mac.conf less more
0 // Okay, this is only a little C'ish, I'm mixing my language memes a ⏎
1 // wee bit. ⏎
2 // ⏎
3 // admin email: email address of the admin ⏎
4 admin email := foo@bar.com ⏎
5 ⏎
6 // db: host, database, username, and password for database access ⏎
7 db := ⏎
8 host->dbhost, ⏎
9 database->mydb.db, ⏎
10 username->dbsuperuser, ⏎
11 password->dbsuperpass ⏎
12 ⏎
13 // hosts: list of hosts to monitor ⏎
14 hosts := host1.foo.com,host1.bar.com ⏎
15 ⏎
16 note := This is a note, but not a ⏎
17 very long note. With this odd ⏎
18 selection of delimiters it looks ⏎
19 even more weird. ⏎
20 EOF ⏎
21 ⏎
22 // Let's throw some random ACLs out there ⏎
23 declare acl loopback := 127.0.0.1,localhost ⏎
24 declare acl localnet := 192.168.0.0/24,192.168.35.0/24 ⏎
25 ⏎
+26
-0
t/lib/msdos.conf less more
0 // Okay, this is only a little C'ish, I'm mixing my language memes a
1 // wee bit.
2 //
3 // admin email: email address of the admin
4 admin email := foo@bar.com
5
6 // db: host, database, username, and password for database access
7 db :=
8 host->dbhost,
9 database->mydb.db,
10 username->dbsuperuser,
11 password->dbsuperpass
12
13 // hosts: list of hosts to monitor
14 hosts := host1.foo.com,host1.bar.com
15
16 note := This is a note, but not a
17 very long note. With this odd
18 selection of delimiters it looks
19 even more weird.
20 EOF
21
22 // Let's throw some random ACLs out there
23 declare acl loopback := 127.0.0.1,localhost
24 declare acl localnet := 192.168.0.0/24,192.168.35.0/24
25
+28
-0
t/lib/unix.conf less more
0 // Okay, this is only a little C'ish, I'm mixing my language memes a
1 // wee bit.
2 //
3 // admin email: email address of the admin
4 admin email := foo@bar.com
5
6 // db: host, database, username, and password for database access
7 db :=
8 host->dbhost,
9 database->mydb.db,
10 username->dbsuperuser,
11 password->dbsuperpass
12
13 // hosts: list of hosts to monitor
14 hosts := host1.foo.com,host1.bar.com
15
16 note := This is a note, but not a
17 very long note. With this odd
18 selection of delimiters it looks
19 even more weird.
20 EOF
21
22 // Let's throw some random ACLs out there
23 declare acl loopback := 127.0.0.1,localhost
24 declare acl localnet := 192.168.0.0/24,192.168.35.0/24
25
26 include t/lib/*_include_me.conf
27
+0
-29
t/testrc less more
0 # Scalar tests
1 SCALAR 1: value1
2 SCALAR 2: "these, are, all one => value"
3 SCALAR 3: this is a \
4 continued line.
5 SCALAR 4: ASDFKAS234123098ASDFA9082341\
6 ASDFIO23489078907SFASDF8A972
7 SCALAR 5: this is a really long text that should definitely cause the output \
8 generator to wrap lines -- hopefully breaking along whitespace. \
9 I should also generation a really freaking long line just to see \
10 it break on non-whitespace as well. Well, how about this: \
11 AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\
12 BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB\
13 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC\
14 DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD
15 # List tests
16 LIST 1: value1, value2, value3
17 LIST 2: value1, "two, parts", value3, "\"two => parts\""
18 LIST 3: value1, "two, parts", "two => parts"
19
20 # Hash tests
21 HASH 1: one => 1, two => 2, three => "Three for Me! 3 => 2", \
22 four => 4
23
24 # Disconnected comment
25 #
26
27 # Empty
28 EMPTY:
+0
-22
t/testrc_smart less more
0 # Scalar tests
1 SCALAR 1: value1
2 SCALAR 2: "these, are, all one => value"
3 SCALAR 3: this is a
4 continued line.
5 SCALAR 4: ASDFKAS234123098ASDFA9082341
6 ASDFIO23489078907SFASDF8A972
7
8 # List tests
9 LIST 1: value1, value2,
10 value3
11 LIST 2: value1,
12 "two, parts",
13 value3,
14 "\"two => parts\""
15 LIST 3: value1,
16 "two, parts",
17 two => parts
18
19 # Hash tests
20 HASH 1: one => 1, two => 2, three => "Three for Me! 3 => 2",
21 four => 4
+19
-0
t/v2_01_ini.t less more
0 #!/usr/bin/perl -T
1 # 01_ini.t
2
3 use Test::More tests => 2;
4 use Paranoid;
5 use Parse::PlainConfig::Legacy;
6
7 use strict;
8 use warnings;
9
10 psecureEnv();
11
12 my $conf;
13
14 $conf = Parse::PlainConfig::Legacy->new( 'PARAM_DELIM' => '=', PADDING => 1 );
15 isnt( $conf, undef, 'constructor 3' );
16 isa_ok( $conf, 'Parse::PlainConfig::Legacy', 'constructor 4' );
17
18 # end 01_ini.t
+51
-0
t/v2_02_property.t less more
0 #!/usr/bin/perl -T
1 # 02_property.t
2
3 use Test::More tests => 34;
4 use Paranoid;
5 use Parse::PlainConfig::Legacy;
6
7 use strict;
8 use warnings;
9
10 psecureEnv();
11
12 my $conf = new Parse::PlainConfig::Legacy;
13 my %properties = (
14 PARAM_DELIM => '*',
15 LIST_DELIM => ':',
16 HASH_DELIM => '>',
17 AUTOPURGE => 1,
18 SMART_PARSER => 1,
19 PADDING => 3,
20 FILE => 'foo',
21 MTIME => 3,
22 );
23 my ($key, $value, %tmp);
24
25 # Test setting bad properties/values
26 ok( !eval '$conf->property( FOO => "bar" )', 'bad property 1');
27 ok( !$conf->property( PARAM_DELIM => [] ), 'bad property 2');
28 ok( !$conf->property( ORDER => "foo" ), 'bad property 3');
29 ok( !$conf->property( COERCE => [] ), 'bad property 4');
30 ok( !$conf->property( COERCE => { FOO => 'bar' } ), 'bad property 5');
31
32 # Test valid properties
33 while ( ( $key, $value ) = each %properties ) {
34 isnt( $conf->property( $key ), $value, "property $key default value" );
35 ok( $conf->property( $key => $value ), "property $key set");
36 is( $conf->property( $key ), $value, "property $key value $value");
37 }
38 ok( $conf->property( ORDER => [ qw(FOO BAR ROO) ] ), 'property ORDER set');
39 ($key, $value) = @{ $conf->property( 'ORDER' ) };
40 is( $value, 'BAR', 'property ORDER get');
41 ok( $conf->property( COERCE => {
42 FOO => 'list',
43 BAR => 'string',
44 ROO => 'hash',
45 }), 'property COERCE set');
46 %tmp = %{ $conf->property( 'COERCE' ) };
47 is( $tmp{FOO}, 'list', 'property COERCE get');
48 ok( $conf->property( MAX_BYTES => 512 ), 'property MAX_BYTES set' );
49
50 # end 02_property.t
+22
-0
t/v2_03_read.t less more
0 #!/usr/bin/perl -T
1 # 03_read.t
2
3 use Test::More tests => 3;
4 use Paranoid;
5 use Parse::PlainConfig::Legacy;
6
7 use strict;
8 use warnings;
9
10 psecureEnv();
11
12 my $testrc = "./t/v2_testrc";
13 my $conf = new Parse::PlainConfig::Legacy;
14 my @p;
15
16 ok( !$conf->read( "${testrc}-1" ), 'read 1' );
17 ok( $conf->read( $testrc ), 'read 2' );
18 @p = $conf->parameters;
19 is( scalar( grep( /^SCALAR 1$/, @p ) ), 1, 'check parameters' );
20
21 # end 03_read.t
+29
-0
t/v2_04_parameters.t less more
0 #!/usr/bin/perl -T
1 # 04_parameters.t
2
3 use Test::More tests => 8;
4 use Paranoid;
5 use Parse::PlainConfig::Legacy;
6
7 use strict;
8 use warnings;
9
10 psecureEnv();
11
12 my $testrc = "./t/v2_testrc";
13 my $conf = Parse::PlainConfig::Legacy->new(FILE => $testrc);
14 my @test = ("SCALAR 1", "SCALAR 2", "SCALAR 3", "LIST 1", "LIST 2",
15 "HASH 1");
16 my (@params, $p);
17
18 # 1 Make sure parameters have been read
19 ok( $conf->read, 'read 1');
20 @params = $conf->parameters;
21 is( scalar(@params), 10, '# of parameters read' );
22
23 foreach my $t (@test) {
24 ($p) = grep /^\Q$t\E$/, @params;
25 is( $p, $t, "parameter $t" );
26 }
27
28 # end 04_parameters.t
+42
-0
t/v2_05_purge.t less more
0 #!/usr/bin/perl -T
1 # 05_purge.t
2
3 use Test::More tests => 10;
4 use Paranoid;
5 use Parse::PlainConfig::Legacy;
6
7 use strict;
8 use warnings;
9
10 psecureEnv();
11
12 my $testrc = "./t/v2_testrc";
13 my $conf = Parse::PlainConfig::Legacy->new(FILE => $testrc);
14 my (@params, $p);
15
16 ok( $conf->read, 'read 1' );
17 @params = $conf->parameters;
18 ok( scalar @params > 1, 'has parameters 1' );
19 ok( $conf->purge, 'purge 1');
20 @params = $conf->parameters;
21 ok( scalar @params == 0, 'has parameters 2' );
22
23 $conf = Parse::PlainConfig::Legacy->new(
24 FILE => $testrc,
25 DEFAULTS => {
26 'SCALAR 1' => 'foo',
27 'SCALAR 2' => 'bar',
28 'UNDEC' => 5,
29 },
30 );
31 ok( $conf->read, 'read 2' );
32 ok( $conf->purge, 'purge 2');
33 @params = $conf->parameters;
34 ok( scalar @params > 1, 'has parameters 3' );
35 ($p) = grep /^UNDEC$/, @params;
36 ok( $p eq 'UNDEC', 'has default parameter' );
37 is( $conf->parameter( 'UNDEC' ), 5, 'default param value match' );
38 @params = $conf->parameters;
39 ok( scalar @params == 3, 'has parameters 4' );
40
41 # end 05_purge.t
+98
-0
t/v2_06_scalar.t less more
0 # 06_scalar.t
1 #
2 # Tests for proper extraction of scalar values
3
4 use Parse::PlainConfig::Legacy;
5
6 $|++;
7 print "1..13\n";
8
9 my $test = 1;
10 my $rcfile = './t/v2_testrc';
11 my $conf = Parse::PlainConfig::Legacy->new(FILE => $rcfile);
12
13 # First series with smart parser off
14 #
15 # 1 scalar 1
16 $conf->read($rcfile);
17 $conf->parameter("SCALAR 1") eq "value1" ? print "ok $test\n" :
18 print "not ok $test\n";
19 $test++;
20
21 # 2 scalar 2
22 $conf->parameter("SCALAR 2") eq "these, are, all one => value" ?
23 print "ok $test\n" : print "not ok $test\n";
24 $test++;
25
26 # 3 scalar 3
27 $conf->parameter("SCALAR 3") eq "this is a continued line." ?
28 print "ok $test\n" : print "not ok $test\n";
29 $test++;
30
31 # 4 scalar 4
32 $conf->parameter("SCALAR 4") eq
33 "ASDFKAS234123098ASDFA9082341ASDFIO23489078907SFASDF8A972" ?
34 print "ok $test\n" : print "not ok $test\n";
35 $test++;
36
37 # Second series with smart parser on
38 #
39 # 5 scalar 1
40 $conf->property(SMART_PARSER => 1);
41 $conf->property(AUTOPURGE => 1);
42 $conf->read("${rcfile}_smart");
43 $conf->parameter("SCALAR 1") eq "value1" ? print "ok $test\n" :
44 print "not ok $test\n";
45 $test++;
46
47 # 6 scalar 2
48 $conf->parameter("SCALAR 2") eq "these, are, all one => value" ?
49 print "ok $test\n" : print "not ok $test\n";
50 $test++;
51
52 # 7 scalar 3
53 $conf->parameter("SCALAR 3") eq "this is a continued line." ?
54 print "ok $test\n" : print "not ok $test\n";
55 $test++;
56
57 # 8 scalar 4
58 $conf->parameter("SCALAR 4") eq
59 "ASDFKAS234123098ASDFA9082341ASDFIO23489078907SFASDF8A972" ?
60 print "ok $test\n" : print "not ok $test\n";
61 $test++;
62
63 # 9 scalar 2 with scalar coercion set and smart parsing
64 $conf->coerce("string", "SCALAR 2");
65 $conf->read;
66 $conf->parameter("SCALAR 2") eq '"these, are, all one => value"' ?
67 print "ok $test\n" : print "not ok $test\n";
68 $test++;
69
70 # Set tests
71 #
72 # 10 new scalar 1
73 $conf->parameter("NEW SCALAR 1", "this is new");
74 $conf->parameter("NEW SCALAR 1") eq "this is new" ?
75 print "ok $test\n" : print "not ok $test\n";
76 $test++;
77
78 # 11 new scalar 2 with coercion set
79 $conf->coerce("string", "NEW SCALAR 2");
80 $conf->parameter("NEW SCALAR 2", "this is also new");
81 $conf->parameter("NEW SCALAR 2") eq "this is also new" ?
82 print "ok $test\n" : print "not ok $test\n";
83 $test++;
84
85 # 12 new scalar 2 with list value
86 $conf->parameter("NEW SCALAR 2", [qw(this is new again)]);
87 $conf->parameter("NEW SCALAR 2") eq "this , is , new , again" ?
88 print "ok $test\n" : print "not ok $test\n";
89 $test++;
90
91 # 13 new scalar 2 with hash value
92 $conf->parameter("NEW SCALAR 2", {qw(this is new indeed)});
93 $conf->parameter("NEW SCALAR 2") eq "new => indeed , this => is" ?
94 print "ok $test\n" : print "not ok $test\n";
95 $test++;
96
97 # end 06_scalar.t
+81
-0
t/v2_07_list.t less more
0 # 07_list.t
1 #
2 # Tests for proper extraction of scalar values
3
4 use Parse::PlainConfig::Legacy;
5
6 $|++;
7 print "1..10\n";
8
9 my $test = 1;
10 my $rcfile = './t/v2_testrc';
11 my $conf = Parse::PlainConfig::Legacy->new(FILE => $rcfile);
12
13 # First series with smart parser off
14 #
15 # 1 list 1
16 $conf->read($rcfile);
17 ($conf->parameter("LIST 1"))[2] eq "value3" ? print "ok $test\n" :
18 print "not ok $test\n";
19 $test++;
20
21 # 2 list 2
22 ($conf->parameter("LIST 2"))[1] eq "two, parts" ? print "ok $test\n" :
23 print "not ok $test\n";
24 $test++;
25
26 # 3 list 3
27 ($conf->parameter("LIST 3"))[2] eq "two => parts" ? print "ok $test\n" :
28 print "not ok $test\n";
29 $test++;
30
31 # Second series with smart parser on
32 #
33 # 4 list 1
34 $conf->property(SMART_PARSER => 1);
35 $conf->property(AUTOPURGE => 1);
36 $conf->read("${rcfile}_smart");
37 ($conf->parameter("LIST 1"))[2] eq "value3" ? print "ok $test\n" :
38 print "not ok $test\n";
39 $test++;
40
41 # 5 list 2
42 ($conf->parameter("LIST 2"))[1] eq "two, parts" ? print "ok $test\n" :
43 print "not ok $test\n";
44 $test++;
45
46 # 6 list 3 with list coercion set and smart parsing
47 $conf->coerce("list", "LIST 3");
48 $conf->read;
49 ($conf->parameter("LIST 3"))[2] eq "two => parts" ? print "ok $test\n" :
50 print "not ok $test\n";
51 $test++;
52
53 # Set tests
54 #
55 # 7 new list 1
56 $conf->parameter("NEW LIST 1", [qw(this is a new list)]);
57 ($conf->parameter("NEW LIST 1"))[2] eq "a" ? print "ok $test\n" :
58 print "not ok $test\n";
59 $test++;
60
61 # 8 new list 2 with coercion set
62 $conf->coerce("list", "NEW LIST 2");
63 $conf->parameter("NEW LIST 2", [qw(this is a new list)]);
64 ($conf->parameter("NEW LIST 2"))[2] eq "a" ? print "ok $test\n" :
65 print "not ok $test\n";
66 $test++;
67
68 # 9 new list 2 with string value
69 $conf->parameter("NEW LIST 2", "this is new");
70 ($conf->parameter("NEW LIST 2"))[0] eq "this is new" ? print "ok $test\n" :
71 print "not ok $test\n";
72 $test++;
73
74 # 10 new list 2 with hash value
75 $conf->parameter("NEW LIST 2", { 'this' => 'is', 'also' => 'new' });
76 ($conf->parameter("NEW LIST 2"))[2] eq "this" ? print "ok $test\n" :
77 print "not ok $test\n";
78 $test++;
79
80 # end 07_list.t
+52
-0
t/v2_08_hash.t less more
0 # 08_hash.t
1 #
2 # Tests for proper extraction of hash values
3
4 use Parse::PlainConfig::Legacy;
5
6 $|++;
7 print "1..6\n";
8
9 my $test = 1;
10 my $rcfile = './t/v2_testrc';
11 my $conf = Parse::PlainConfig::Legacy->new(FILE => $rcfile);
12 $conf->read($rcfile);
13 my %hash = ( $conf->parameter("HASH 1") );
14
15 # 1 hash 1
16 $hash{two} eq "2" ? print "ok $test\n" : print "not ok $test\n";
17 $test++;
18
19 # 2 hash 1
20 $hash{three} eq "Three for Me! 3 => 2" ? print "ok $test\n" :
21 print "not ok $test\n";
22 $test++;
23
24 # Set tests
25 #
26 # 3 new hash 1
27 $conf->parameter('NEW HASH 1', { 'foo' => 'bar' });
28 %hash = $conf->parameter('NEW HASH 1');
29 $hash{foo} eq "bar" ? print "ok $test\n" : print "not ok $test\n";
30 $test++;
31
32 # 4 new hash 2 with coercion set
33 $conf->coerce('hash', 'NEW HASH 2');
34 $conf->parameter('NEW HASH 2', { 'foo' => 'bar' });
35 %hash = $conf->parameter('NEW HASH 2');
36 $hash{foo} eq "bar" ? print "ok $test\n" : print "not ok $test\n";
37 $test++;
38
39 # 5 new hash 2 with string value
40 $conf->parameter('NEW HASH 2', "bar => foo");
41 %hash = $conf->parameter('NEW HASH 2');
42 $hash{bar} eq "foo" ? print "ok $test\n" : print "not ok $test\n";
43 $test++;
44
45 # 6 new hash 2 with list value
46 $conf->parameter('NEW HASH 2', [qw(foo bar roo)]);
47 %hash = $conf->parameter('NEW HASH 2');
48 $hash{foo} eq "bar" ? print "ok $test\n" : print "not ok $test\n";
49 $test++;
50
51 # end 08_hash.t
+49
-0
t/v2_09_coerce.t less more
0 # 09_coerce.t
1 #
2 # Tests coerce method
3
4 use Parse::PlainConfig::Legacy;
5
6 $|++;
7 print "1..5\n";
8
9 my $test = 1;
10 my $rcfile = './t/v2_testrc_smart';
11 my $conf = Parse::PlainConfig::Legacy->new(
12 FILE => $rcfile,
13 SMART_PARSER => 1,
14 COERCE => {
15 'SCALAR 2' => 'string',
16 'LIST 3' => 'list',
17 },
18 );
19 $conf->read;
20 my %hash;
21
22 # 1 scalar 2
23 $conf->parameter("SCALAR 2") eq '"these, are, all one => value"' ?
24 print "ok $test\n" : print "not ok $test\n";
25 $test++;
26
27 # 2 list 3
28 ($conf->parameter("LIST 3"))[2] eq "two => parts" ? print "ok $test\n" :
29 print "not ok $test\n";
30 $test++;
31
32 # 3 coerce list 1 into string
33 $conf->coerce('string', 'LIST 1');
34 $conf->parameter("LIST 1") eq "value1 , value2 , value3" ?
35 print "ok $test\n" : print "not ok $test\n";
36 $test++;
37
38 # 4 .. 5 coerce scalar 2 into a hash
39 $conf->parameter('SCALAR 2',
40 ($conf->parameter('SCALAR 2') =~ /^"(.*)"$/)[0]);
41 $conf->coerce('hash', 'SCALAR 2');
42 %hash = ( $conf->parameter('SCALAR 2') );
43 $hash{"these"} eq 'are' ? print "ok $test\n" : print "not ok $test\n";
44 $test++;
45 $hash{"all one"} eq 'value' ? print "ok $test\n" : print "not ok $test\n";
46 $test++;
47
48 # end 09_coerce.t
+60
-0
t/v2_10_write.t less more
0 # 10_write.t
1 #
2 # Tests the write method
3
4 use Parse::PlainConfig::Legacy;
5
6 $|++;
7 print "1..6\n";
8
9 my $test = 1;
10 my $conf = new Parse::PlainConfig::Legacy;
11 my $nconf = new Parse::PlainConfig::Legacy;
12 my $testrc = "./t/v2_testrc";
13 $conf->coerce('string', 'SCALAR 5');
14 $conf->read($testrc);
15
16 # 1 write w/o smart
17 $rv = $conf->write("${testrc}_write");
18 $rv ? print "ok $test\n" : print "not ok $test\n";
19 $test++;
20
21 # 2 verify worthiness of new file
22 $rv = $nconf->read("${testrc}_write");
23 $rv ? print "ok $test\n" : print "not ok $test\n";
24 $test++;
25
26 # 3 compare values in both
27 $conf->parameter('SCALAR 5') eq $nconf->parameter('SCALAR 5') ?
28 print "ok $test\n" : print "not ok $test\n";
29 unlink "${testrc}_write";
30 $test++;
31
32 # 4 write w/smart
33 $conf->property("SMART_PARSER", 1);
34 $conf->coerce('string', 'SCALAR 1', 'SCALAR 2', 'SCALAR 3', 'SCALAR 4',
35 'SCALAR 5');
36 $conf->coerce('list', 'LIST 1', 'LIST 2', 'LIST 3');
37 $conf->coerce('hash', 'HASH 1');
38 $rv = $conf->write("${testrc}_write_smart");
39 $rv ? print "ok $test\n" : print "not ok $test\n";
40 $test++;
41
42 # 5 verify worthiness of new file
43 $nconf->purge;
44 $nconf->property("SMART_PARSER", 1);
45 $nconf->coerce('string', 'SCALAR 1', 'SCALAR 2', 'SCALAR 3', 'SCALAR 4',
46 'SCALAR 5');
47 $nconf->coerce('list', 'LIST 1', 'LIST 2', 'LIST 3');
48 $nconf->coerce('hash', 'HASH 1');
49 $nconf->read("${testrc}_write_smart");
50 $rv ? print "ok $test\n" : print "not ok $test\n";
51 $test++;
52
53 # 6 compare values in both
54 $conf->parameter('SCALAR 5') eq $nconf->parameter('SCALAR 5') ?
55 print "ok $test\n" : print "not ok $test\n";
56 unlink "${testrc}_write_smart";
57 $test++;
58
59 # end 10_write.t
+39
-0
t/v2_11_order.t less more
0 # 11_order.t
1 #
2 # Tests the order method
3
4 use Parse::PlainConfig::Legacy;
5
6 $|++;
7 print "1..2\n";
8
9 my $test = 1;
10 my $conf = new Parse::PlainConfig::Legacy;
11 my $nconf = new Parse::PlainConfig::Legacy;
12 my $testrc = "./t/v2_testrc";
13 $conf->coerce('string', 'SCALAR 5');
14 $conf->read($testrc);
15
16 # 1 change order and write w/smart
17 $conf->property("SMART_PARSER", 1);
18 $conf->coerce('string', 'SCALAR 1', 'SCALAR 2', 'SCALAR 3', 'SCALAR 4',
19 'SCALAR 5');
20 $conf->coerce('list', 'LIST 1', 'LIST 2', 'LIST 3');
21 $conf->coerce('hash', 'HASH 1');
22 $conf->order('HASH 1', 'LIST 3', 'SCALAR 5');
23 $rv = $conf->write("${testrc}_order");
24 $rv ? print "ok $test\n" : print "not ok $test\n";
25 $test++;
26
27 # 2 read and compare order
28 $nconf->property("SMART_PARSER", 1);
29 $nconf->coerce('string', 'SCALAR 1', 'SCALAR 2', 'SCALAR 3', 'SCALAR 4',
30 'SCALAR 5');
31 $nconf->coerce('list', 'LIST 1', 'LIST 2', 'LIST 3');
32 $nconf->coerce('hash', 'HASH 1');
33 $nconf->read("${testrc}_order");
34 ($nconf->order)[0] eq 'HASH 1' ? print "ok $test\n" : print "not ok $test\n";
35 unlink "${testrc}_order";
36 $test++;
37
38 # end 11_order.t
+39
-0
t/v2_12_purge.t less more
0 # 12_purge.t
1 #
2 # Tests the purge and autopurge functionality
3
4 use Parse::PlainConfig::Legacy;
5
6 $|++;
7 print "1..5\n";
8
9 my $test = 1;
10 my $conf = new Parse::PlainConfig::Legacy;
11 my $testrc = "./t/v2_testrc";
12 my ($val, $val2, @params);
13 $conf->read($testrc);
14
15 # 1 & 2 Test purge
16 @params = $conf->parameters();
17 @params ? print "ok $test\n" : print "not ok $test\n";
18 $test++;
19 $conf->purge();
20 @params = $conf->parameters();
21 @params ? print "not ok $test\n" : print "ok $test\n";
22 $test++;
23
24 # 3 .. 5 Test autopurge
25 $conf->read;
26 $conf->parameter("FOO" => "BAR");
27 @params = $conf->parameters();
28 grep(/^FOO$/, @params) ? print "ok $test\n" : print "not ok $test\n";
29 $test++;
30 $conf->property("AUTOPURGE" => 1);
31 $conf->read;
32 @params = $conf->parameters();
33 grep(/^FOO$/, @params) ? print "not ok $test\n" : print "ok $test\n";
34 $test++;
35 @params ? print "ok $test\n" : print "not ok $test\n";
36 $test++;
37
38 # end 12_purge.t
+60
-0
t/v2_13_readIfNewer.t less more
0 # 13_readIfNewer.t
1 #
2 # Tests the readIfNewer method
3
4 use Parse::PlainConfig::Legacy;
5
6 $|++;
7 print "1..8\n";
8
9 my $test = 1;
10 my $conf1 = new Parse::PlainConfig::Legacy;
11 my $conf2 = new Parse::PlainConfig::Legacy;
12 my $testrc = "./t/v2_testrc-tmp";
13 my $rv;
14
15 # 1 & 2 Load & write to temp file
16 $rv = $conf1->read("./t/v2_testrc");
17 $rv ? print "ok $test\n" : print "not ok $test\n";
18 $test++;
19 $rv = $conf1->write($testrc);
20 $rv ? print "ok $test\n" : print "not ok $test\n";
21 $test++;
22 $conf1->property(FILE => $testrc);
23
24 # 3 Load conf2 w/temp file
25 $rv = $conf2->read($testrc);
26 $rv ? print "ok $test\n" : print "not ok $test\n";
27 $test++;
28
29 # 4 Write new value w/conf1
30 sleep 3;
31 $conf1->parameter("FOO" => "BAR");
32 $rv = $conf1->write;
33 $rv ? print "ok $test\n" : print "not ok $test\n";
34 $test++;
35
36 # 5 Reread w/conf2
37 sleep 3;
38 $rv = $conf2->readIfNewer;
39 $rv == 1 ? print "ok $test\n" : print "not ok $test\n";
40 $test++;
41
42 # 6 Make sure new value is there
43 grep(/^FOO$/, $conf2->parameters) ? print "ok $test\n" :
44 print "not ok $test\n";
45 $test++;
46
47 # 7 Reread once more
48 sleep 1;
49 $rv = $conf2->readIfNewer;
50 $rv == 2 ? print "ok $test\n" : print "not ok $test\n";
51 $test++;
52
53 # 8 Unlink file and reread
54 unlink $testrc;
55 $rv = $conf2->readIfNewer;
56 $rv ? print "not ok $test\n" : print "ok $test\n";
57 $test++;
58
59 # end 13_readIfNewer.t
+30
-0
t/v2_15_defaults.t less more
0 # 15_defaults.t
1 #
2 # Test the defaults capability
3
4 use Parse::PlainConfig::Legacy;
5
6 $|++;
7 print "1..2\n";
8
9 my $test = 1;
10 my $conf = new Parse::PlainConfig::Legacy;
11 my $testrc = "./t/v2_testrc";
12 my ($val, $val2);
13 $conf->read($testrc);
14 $conf->property(DEFAULTS =>
15 {
16 NOT_PRESENT => 1,
17 });
18
19 # 1 Test defaults
20 $val = $conf->parameter('NOT_PRESENT');
21 $val == 1 ? print "ok $test\n" : print "not ok $test\n";
22 $test++;
23
24 # 2 Test present key
25 $val = $conf->parameter('SCALAR 1');
26 $val eq 'value1' ? print "ok $test\n" : print "not ok $test\n";
27 $test++;
28
29 # end 15_defaults.t
+35
-0
t/v2_16_hasParameter.t less more
0 # 16_hasParameter.t
1 #
2 # Tests the traditional usage for backwards compatibility
3
4 use Parse::PlainConfig::Legacy;
5
6 $|++;
7 print "1..3\n";
8
9 my $test = 1;
10 my $conf = new Parse::PlainConfig::Legacy;
11 my $testrc = "./t/v2_testrc";
12 my ($val, $val2);
13 $conf->read($testrc);
14 $conf->property(DEFAULTS =>
15 {
16 NOT_PRESENT => 1,
17 });
18
19 # 1 Test key that exists in the defaults hash
20 $rv = $conf->hasParameter('NOT_PRESENT');
21 $rv ? print "ok $test\n" : print "not ok $test\n";
22 $test++;
23
24 # 2 Test present key
25 $rv = $conf->hasParameter('SCALAR 1');
26 $rv ? print "ok $test\n" : print "not ok $test\n";
27 $test++;
28
29 # 3 Test invalid key
30 $rv = ! $conf->hasParameter('NOT_THERE');
31 $rv ? print "ok $test\n" : print "not ok $test\n";
32 $test++;
33
34 # end 16_hasParameter.t
+29
-0
t/v2_testrc less more
0 # Scalar tests
1 SCALAR 1: value1
2 SCALAR 2: "these, are, all one => value"
3 SCALAR 3: this is a \
4 continued line.
5 SCALAR 4: ASDFKAS234123098ASDFA9082341\
6 ASDFIO23489078907SFASDF8A972
7 SCALAR 5: this is a really long text that should definitely cause the output \
8 generator to wrap lines -- hopefully breaking along whitespace. \
9 I should also generation a really freaking long line just to see \
10 it break on non-whitespace as well. Well, how about this: \
11 AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA\
12 BBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBBB\
13 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC\
14 DDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDDD
15 # List tests
16 LIST 1: value1, value2, value3
17 LIST 2: value1, "two, parts", value3, "\"two => parts\""
18 LIST 3: value1, "two, parts", "two => parts"
19
20 # Hash tests
21 HASH 1: one => 1, two => 2, three => "Three for Me! 3 => 2", \
22 four => 4
23
24 # Disconnected comment
25 #
26
27 # Empty
28 EMPTY:
+22
-0
t/v2_testrc_smart less more
0 # Scalar tests
1 SCALAR 1: value1
2 SCALAR 2: "these, are, all one => value"
3 SCALAR 3: this is a
4 continued line.
5 SCALAR 4: ASDFKAS234123098ASDFA9082341
6 ASDFIO23489078907SFASDF8A972
7
8 # List tests
9 LIST 1: value1, value2,
10 value3
11 LIST 2: value1,
12 "two, parts",
13 value3,
14 "\"two => parts\""
15 LIST 3: value1,
16 "two, parts",
17 two => parts
18
19 # Hash tests
20 HASH 1: one => 1, two => 2, three => "Three for Me! 3 => 2",
21 four => 4
+16
-0
t/v3_01_constants.t less more
0 #!/usr/bin/perl -T
1
2 use Test::More tests => 3;
3 use Paranoid;
4 use Parse::PlainConfig::Constants;
5 use Class::EHierarchy qw(:all);
6
7 use strict;
8 use warnings;
9
10 psecureEnv();
11
12 is( PPC_SCALAR, CEH_SCALAR, 'PPC_SCALAR' );
13 is( PPC_ARRAY, CEH_ARRAY, 'PPC_ARRAY' );
14 is( PPC_HASH, CEH_HASH, 'PPC_HASH' );
15
+20
-0
t/v3_02_init.t less more
0 #!/usr/bin/perl -T
1
2 use Test::More tests => 2;
3 use Paranoid;
4 use Paranoid::Debug;
5 use Parse::PlainConfig;
6
7 use strict;
8 use warnings;
9
10 psecureEnv();
11
12 use lib qw(t/lib);
13 use MyConf;
14
15 #PDEBUG = 20;
16 my $obj = new MyConf;
17 ok( defined $obj, 'new object - 1' );
18 ok( length $obj->default, 'conf default - 1' );
19
+60
-0
t/v3_03_parameters.t less more
0 #!/usr/bin/perl -T
1
2 use Test::More tests => 25;
3 use Paranoid;
4 use Paranoid::Debug;
5 use Parse::PlainConfig;
6
7 use strict;
8 use warnings;
9
10 psecureEnv();
11
12 use lib qw(t/lib);
13 use MyConf;
14
15 #PDEBUG = 20;
16 my $obj = new MyConf;
17 ok( defined $obj, 'new object - 1' );
18 my $val = $obj->get('admin email');
19 is( $val, 'root@localhost', 'default scalar retrieval' );
20 my @val = $obj->get('hosts');
21 is( $val[0], 'localhost', 'default array retrieval' );
22 my %val = $obj->get('db');
23 is( $val{database}, 'sample.db', 'default hash retrieval' );
24 $val = $obj->get('note');
25 ok( length $val, 'default hdoc retrieval' );
26 ($val) = $obj->get('loopback');
27 is( $val, '127.0.0.1', 'default proto retrieval' );
28 $val = $obj->get('nodefault');
29 ok( !defined $val, 'nodefault retrieval' );
30 ok( $obj->set( 'nodefault', 'set' ), 'set parameter' );
31 $val = $obj->get('nodefault');
32 is( $val, 'set', 'get parameter' );
33 ok( $obj->set( 'loopback', $obj->get('localnet') ), 'set prototype' );
34 ($val) = $obj->get('loopback');
35 is( $val, '192.168.0.0/24', 'get prototype' );
36
37 $val = [ $obj->prototyped ];
38 is( scalar @$val, 3, 'prototyped all 1' );
39 ok( ( scalar grep { $_ eq 'loopback' } @$val ), 'prototyped all 2' );
40 $val = [ $obj->prototyped('declare acl') ];
41 is( scalar @$val, 2, 'prototyped specific 1' );
42 ok( ( scalar grep { $_ eq 'loopback' } @$val ), 'prototyped specific 2' );
43 $val = [ $obj->prototyped('declare foo') ];
44 is( scalar @$val, 1, 'prototyped specific 3' );
45 ok( ( scalar grep { $_ eq 'bar' } @$val ), 'prototyped specific 4' );
46
47 ok( $obj->reset, 'reset config' );
48 $val = $obj->get('nodefault');
49 ok( !defined $val, 'nodefault retrieval 2' );
50 ($val) = $obj->get('loopback');
51 is( $val, '127.0.0.1', 'default proto retrieval 2' );
52
53 #PDEBUG = 9;
54 ok( !$obj->parse('gack! Spurious text!!!'), 'spurious text 1' );
55 ok( !$obj->parse('declare acl db foo'), 'proto/prop conflict 1' );
56 ok( !$obj->parse('declare foo localnet bar'), 'proto/prop conflict 2' );
57 ok( !$obj->set( 'admin user', 'foo' ), 'invalid prop 1' );
58 ok( !$obj->get('admin user'), 'invalid prop 2' );
59
+18
-0
t/v3_04_bad_conf.t less more
0 #!/usr/bin/perl -T
1
2 use Test::More tests => 1;
3 use Paranoid;
4 use Paranoid::Debug;
5 use Parse::PlainConfig;
6
7 use strict;
8 use warnings;
9
10 psecureEnv();
11
12 use lib qw(t/lib);
13 use BadConf;
14
15 my $obj = new BadConf;
16 ok( !defined $obj, 'new object - 1' );
17
+43
-0
t/v3_05_no_defaults.t less more
0 #!/usr/bin/perl -T
1
2 use Test::More tests => 14;
3 use Paranoid;
4 use Paranoid::Debug;
5 use Parse::PlainConfig;
6
7 use strict;
8 use warnings;
9
10 psecureEnv();
11
12 use lib qw(t/lib);
13 use NoDefaults;
14
15 #PDEBUG = 20;
16 my $obj = new NoDefaults;
17 ok( defined $obj, 'new object - 1' );
18 my $val = $obj->get('admin email');
19 is( $val, undef, 'default scalar retrieval' );
20 my @val = $obj->get('hosts');
21 is( $val[0], undef, 'default array retrieval' );
22 my %val = $obj->get('db');
23 is( $val{database}, undef, 'default hash retrieval' );
24 $val = $obj->get('note');
25 ok( !length $val, 'default hdoc retrieval' );
26 ($val) = $obj->get('loopback');
27 is( $val, undef, 'default proto retrieval' );
28 $val = $obj->get('nodefault');
29 ok( !defined $val, 'nodefault retrieval' );
30 ok( $obj->set('nodefault', 'set'), 'set parameter');
31 $val = $obj->get('nodefault');
32 is( $val, 'set', 'get parameter' );
33
34 ok($obj->reset, 'reset config');
35 $val = $obj->get('nodefault');
36 ok( !defined $val, 'nodefault retrieval 2' );
37
38 #PDEBUG = 9;
39 ok(! $obj->parse('gack! Spurious text!!!'), 'spurious text 1');
40 ok(! $obj->set('admin user', 'foo'), 'invalid prop 1');
41 ok(! $obj->get('admin user'), 'invalid prop 2');
42
+50
-0
t/v3_06_c_style.t less more
0 #!/usr/bin/perl -T
1
2 use Test::More tests => 19;
3 use Paranoid;
4 use Paranoid::Debug;
5 use Parse::PlainConfig;
6
7 use strict;
8 use warnings;
9
10 psecureEnv();
11
12 use lib qw(t/lib);
13 use CStyle;
14
15 #PDEBUG = 20;
16 my $obj = new CStyle;
17 ok( defined $obj, 'new object - 1' );
18 my $val = $obj->get('admin email');
19 is( $val, 'root@localhost', 'default scalar retrieval' );
20 my @val = $obj->get('hosts');
21 is( $val[0], 'localhost', 'default array retrieval' );
22 my %val = $obj->get('db');
23 is( $val{database}, 'sample.db', 'default hash retrieval' );
24 $val = $obj->get('note');
25 ok( length $val, 'default hdoc retrieval' );
26 ($val) = $obj->get('loopback');
27 is( $val, '127.0.0.1', 'default proto retrieval' );
28 $val = $obj->get('nodefault');
29 ok( !defined $val, 'nodefault retrieval' );
30 ok( $obj->set('nodefault', 'set'), 'set parameter');
31 $val = $obj->get('nodefault');
32 is( $val, 'set', 'get parameter' );
33 ok( $obj->set('loopback', $obj->get('localnet')), 'set prototype');
34 ($val) = $obj->get('loopback');
35 is( $val, '192.168.0.0/24', 'get prototype');
36
37 ok($obj->reset, 'reset config');
38 $val = $obj->get('nodefault');
39 ok( !defined $val, 'nodefault retrieval 2' );
40 ($val) = $obj->get('loopback');
41 is( $val, '127.0.0.1', 'default proto retrieval 2' );
42
43 #PDEBUG = 9;
44 ok(! $obj->parse('gack! Spurious text!!!'), 'spurious text 1');
45 ok(! $obj->parse('declare acl db := foo'), 'proto/prop conflict 1');
46 ok(! $obj->parse('declare foo localnet := bar'), 'proto/prop conflict 2');
47 ok(! $obj->set('admin user', 'foo'), 'invalid prop 1');
48 ok(! $obj->get('admin user'), 'invalid prop 2');
49
+43
-0
t/v3_07_unix.t less more
0 #!/usr/bin/perl -T
1
2 use Test::More tests => 15;
3 use Paranoid;
4 use Paranoid::Debug;
5 use Parse::PlainConfig;
6
7 use strict;
8 use warnings;
9
10 psecureEnv();
11
12 use lib qw(t/lib);
13 use CStyle;
14
15 my $obj = new CStyle;
16 ok( defined $obj, 'new object - 1' );
17 ok( $obj->read('t/lib/unix.conf'), 'config read');
18 my $val = $obj->get('admin email');
19 is( $val, 'foo@bar.com', 'default scalar retrieval' );
20 my @val = $obj->get('hosts');
21 is( $val[0], 'host1.foo.com', 'default array retrieval' );
22 my %val = $obj->get('db');
23 is( $val{database}, 'mydb.db', 'default hash retrieval' );
24 $val = $obj->get('note');
25 ok( length $val, 'default hdoc retrieval' );
26 ($val) = $obj->get('loopback');
27 is( $val, '127.0.0.1', 'default proto retrieval' );
28 $val = $obj->get('nodefault');
29 is( $val, 'whoops!', 'nodefault retrieval' );
30 ok( $obj->set('nodefault', 'set'), 'set parameter');
31 $val = $obj->get('nodefault');
32 is( $val, 'set', 'get parameter' );
33 ok( $obj->set('loopback', $obj->get('localnet')), 'set prototype');
34 ($val) = $obj->get('loopback');
35 is( $val, '192.168.0.0/24', 'get prototype');
36
37 ok($obj->reset, 'reset config');
38 $val = $obj->get('nodefault');
39 ok( !defined $val, 'nodefault retrieval 2' );
40 ($val) = $obj->get('loopback');
41 is( $val, '127.0.0.1', 'default proto retrieval 2' );
42
+44
-0
t/v3_08_msdos.t less more
0 #!/usr/bin/perl -T
1
2 use Test::More tests => 15;
3 use Paranoid;
4 use Paranoid::Debug;
5 use Parse::PlainConfig;
6
7 use strict;
8 use warnings;
9
10 psecureEnv();
11
12 use lib qw(t/lib);
13 use CStyle;
14
15 #PDEBUG = 20;
16 my $obj = new CStyle;
17 ok( defined $obj, 'new object - 1' );
18 ok( $obj->read('t/lib/msdos.conf'), 'config read');
19 my $val = $obj->get('admin email');
20 is( $val, 'foo@bar.com', 'default scalar retrieval' );
21 my @val = $obj->get('hosts');
22 is( $val[0], 'host1.foo.com', 'default array retrieval' );
23 my %val = $obj->get('db');
24 is( $val{database}, 'mydb.db', 'default hash retrieval' );
25 $val = $obj->get('note');
26 ok( length $val, 'default hdoc retrieval' );
27 ($val) = $obj->get('loopback');
28 is( $val, '127.0.0.1', 'default proto retrieval' );
29 $val = $obj->get('nodefault');
30 ok( !defined $val, 'nodefault retrieval' );
31 ok( $obj->set('nodefault', 'set'), 'set parameter');
32 $val = $obj->get('nodefault');
33 is( $val, 'set', 'get parameter' );
34 ok( $obj->set('loopback', $obj->get('localnet')), 'set prototype');
35 ($val) = $obj->get('loopback');
36 is( $val, '192.168.0.0/24', 'get prototype');
37
38 ok($obj->reset, 'reset config');
39 $val = $obj->get('nodefault');
40 ok( !defined $val, 'nodefault retrieval 2' );
41 ($val) = $obj->get('loopback');
42 is( $val, '127.0.0.1', 'default proto retrieval 2' );
43
+44
-0
t/v3_09_mac.t less more
0 #!/usr/bin/perl -T
1
2 use Test::More tests => 15;
3 use Paranoid;
4 use Paranoid::Debug;
5 use Parse::PlainConfig;
6
7 use strict;
8 use warnings;
9
10 psecureEnv();
11
12 use lib qw(t/lib);
13 use CStyle;
14
15 #PDEBUG = 20;
16 my $obj = new CStyle;
17 ok( defined $obj, 'new object - 1' );
18 ok( $obj->read('t/lib/mac.conf'), 'config read');
19 my $val = $obj->get('admin email');
20 is( $val, 'foo@bar.com', 'default scalar retrieval' );
21 my @val = $obj->get('hosts');
22 is( $val[0], 'host1.foo.com', 'default array retrieval' );
23 my %val = $obj->get('db');
24 is( $val{database}, 'mydb.db', 'default hash retrieval' );
25 $val = $obj->get('note');
26 ok( length $val, 'default hdoc retrieval' );
27 ($val) = $obj->get('loopback');
28 is( $val, '127.0.0.1', 'default proto retrieval' );
29 $val = $obj->get('nodefault');
30 ok( !defined $val, 'nodefault retrieval' );
31 ok( $obj->set('nodefault', 'set'), 'set parameter');
32 $val = $obj->get('nodefault');
33 is( $val, 'set', 'get parameter' );
34 ok( $obj->set('loopback', $obj->get('localnet')), 'set prototype');
35 ($val) = $obj->get('loopback');
36 is( $val, '192.168.0.0/24', 'get prototype');
37
38 ok($obj->reset, 'reset config');
39 $val = $obj->get('nodefault');
40 ok( !defined $val, 'nodefault retrieval 2' );
41 ($val) = $obj->get('loopback');
42 is( $val, '127.0.0.1', 'default proto retrieval 2' );
43