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