/[pdpsoft]/trunk/fetchcrl/ConfigTiny.pm
ViewVC logotype

Annotation of /trunk/fetchcrl/ConfigTiny.pm

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1759 - (hide annotations) (download) (as text)
Fri Jun 11 15:41:40 2010 UTC (11 years, 5 months ago) by davidg
File MIME type: application/x-perl
File size: 2867 byte(s)
Moved fetch-crl to a tagger part of the repo

1 davidg 1758 package ConfigTiny;
2    
3     # derived from Config::Tiny 2.12, but with some local mods and
4     # some new syntax possibilities
5    
6     # If you thought Config::Simple was small...
7    
8     use strict;
9     BEGIN {
10     require 5.004;
11     $ConfigTiny::VERSION = '2.12';
12     $ConfigTiny::errstr = '';
13     }
14    
15     # Create an empty object
16     sub new { bless {}, shift }
17    
18     # Create an object from a file
19     sub read {
20     my $class = ref $_[0] ? shift : ref shift;
21    
22     # Check the file
23     my $file = shift or return $class->_error( 'You did not specify a file name' );
24     return $class->_error( "File '$file' does not exist" ) unless -e $file;
25     return $class->_error( "'$file' is a directory, not a file" ) unless -f _;
26     return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _;
27    
28     # Slurp in the file
29     local $/ = undef;
30     open CFG, $file or return $class->_error( "Failed to open file '$file': $!" );
31     my $contents = <CFG>;
32     close CFG;
33    
34     return $class->read_string( $contents );
35     }
36    
37     # Create an object from a string
38     sub read_string {
39     my $class = ref $_[0] ? shift : ref shift;
40     my $self = $class;
41     #my $self = bless {}, $class;
42     #my $self = shift;
43     return undef unless defined $_[0];
44    
45     # Parse the file
46     my $ns = '_';
47     my $counter = 0;
48     my $content = shift;
49     $content =~ s/\\(?:\015{1,2}\012|\015|\012)\s*//gm;
50     foreach ( split /(?:\015{1,2}\012|\015|\012)/, $content ) {
51     $counter++;
52    
53     # Skip comments and empty lines
54     next if /^\s*(?:\#|\;|$)/;
55    
56     # Remove inline comments
57     s/\s\;\s.+$//g;
58    
59     # Handle section headers
60     if ( /^\s*\[\s*(.+?)\s*\]\s*$/ ) {
61     # Create the sub-hash if it doesn't exist.
62     # Without this sections without keys will not
63     # appear at all in the completed struct.
64     $self->{$ns = $1} ||= {};
65     next;
66     }
67    
68     # Handle properties
69     if ( /^\s*([^=]+?)\s*=\s*(.*?)\s*$/ ) {
70     $self->{$ns}->{$1} = $2;
71     next;
72     }
73    
74     # Handle settings
75     if ( /^\s*([^=]+?)\s*$/ ) {
76     $self->{$ns}->{$1} = 1;
77     next;
78     }
79    
80     return $self->_error( "Syntax error at line $counter: '$_'" );
81     }
82    
83     return $self;
84     }
85    
86     # Save an object to a file
87     sub write {
88     my $self = shift;
89     my $file = shift or return $self->_error(
90     'No file name provided'
91     );
92    
93     # Write it to the file
94     open( CFG, '>' . $file ) or return $self->_error(
95     "Failed to open file '$file' for writing: $!"
96     );
97     print CFG $self->write_string;
98     close CFG;
99     }
100    
101     # Save an object to a string
102     sub write_string {
103     my $self = shift;
104    
105     my $contents = '';
106     foreach my $section ( sort { (($b eq '_') <=> ($a eq '_')) || ($a cmp $b) } keys %$self ) {
107     my $block = $self->{$section};
108     $contents .= "\n" if length $contents;
109     $contents .= "[$section]\n" unless $section eq '_';
110     foreach my $property ( sort keys %$block ) {
111     $contents .= "$property=$block->{$property}\n";
112     }
113     }
114    
115     $contents;
116     }
117    
118     # Error handling
119     sub errstr { $ConfigTiny::errstr }
120     sub _error { $ConfigTiny::errstr = $_[1]; undef }
121    
122     1;
123    

grid.support@nikhef.nl
ViewVC Help
Powered by ViewVC 1.1.28