trunk/fetchcrl/ConfigTiny.pm

package ConfigTiny;

# derived from Config::Tiny 2.12, but with some local mods and
# some new syntax possibilities

# If you thought Config::Simple was small...

use strict;
BEGIN {
        require 5.004;
        $ConfigTiny::VERSION = '2.12';
        $ConfigTiny::errstr  = '';
}

# Create an empty object
sub new { bless {}, shift }

# Create an object from a file
sub read {
        my $class = ref $_[0] ? shift : ref shift;

        # Check the file
        my $file = shift or return $class->_error( 'You did not specify a file name' );
        return $class->_error( "File '$file' does not exist" )              unless -e $file;
        return $class->_error( "'$file' is a directory, not a file" )       unless -f _;
        return $class->_error( "Insufficient permissions to read '$file'" ) unless -r _;

        # Slurp in the file
        local $/ = undef;
        open CFG, $file or return $class->_error( "Failed to open file '$file': $!" );
        my $contents = <CFG>;
        close CFG;

        return $class->read_string( $contents );
}

# Create an object from a string
sub read_string {
        my $class = ref $_[0] ? shift : ref shift;
        my $self  = $class;
        #my $self  = bless {}, $class;
        #my $self  = shift;
        return undef unless defined $_[0];

        # Parse the file
        my $ns      = '_';
        my $counter = 0;
        my $content = shift;
        $content =~ s/\\(?:\015{1,2}\012|\015|\012)\s*//gm;
        foreach ( split /(?:\015{1,2}\012|\015|\012)/, $content ) {
                $counter++;

                # Skip comments and empty lines
                next if /^\s*(?:\#|\;|$)/;

                # Remove inline comments
                s/\s\;\s.+$//g;

                # Handle section headers
                if ( /^\s*\[\s*(.+?)\s*\]\s*$/ ) {
                        # Create the sub-hash if it doesn't exist.
                        # Without this sections without keys will not
                        # appear at all in the completed struct.
                        $self->{$ns = $1} ||= {};
                        next;
                }

                # Handle properties
                if ( /^\s*([^=]+?)\s*=\s*(.*?)\s*$/ ) {
                        $self->{$ns}->{$1} = $2;
                        next;
                }

                # Handle settings
                if ( /^\s*([^=]+?)\s*$/ ) {
                        $self->{$ns}->{$1} = 1;
                        next;
                }

                return $self->_error( "Syntax error at line $counter: '$_'" );
        }

        return $self;
}

# Save an object to a file
sub write {
        my $self = shift;
        my $file = shift or return $self->_error(
                'No file name provided'
                );

        # Write it to the file
        open( CFG, '>' . $file ) or return $self->_error(
                "Failed to open file '$file' for writing: $!"
                );
        print CFG $self->write_string;
        close CFG;
}

# Save an object to a string
sub write_string {
        my $self = shift;

        my $contents = '';
        foreach my $section ( sort { (($b eq '_') <=> ($a eq '_')) || ($a cmp $b) } keys %$self ) {
                my $block = $self->{$section};
                $contents .= "\n" if length $contents;
                $contents .= "[$section]\n" unless $section eq '_';
                foreach my $property ( sort keys %$block ) {
                        $contents .= "$property=$block->{$property}\n";
                }
        }
        
        $contents;
}

# Error handling
sub errstr { $ConfigTiny::errstr }
sub _error { $ConfigTiny::errstr = $_[1]; undef }

1;

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