Subversion Repositories DevTools

Rev

Go to most recent revision | Details | Last modification | View Log | RSS feed

Rev Author Line No. Line
392 dpurdie 1 
package JatsIniFile;
2 
 
3 
use strict;
4 
use warnings;
5 
 
6 
our $VERSION = '0.01';
7 
 
8 
sub new {
9 
	my $proto = shift;
10 
	my $class = ref($proto) || $proto || 'JatsIniFile';
11 
 
12 
	my $self = {
13 
		__file__    => undef,
14 
		__default__ => 'default',
15 
		__eol__     => "\n",
16 
		__append__  => 1,
17 
		@_,
18 
	};
19 
 
20 
	bless ($self,$class);
21 
	return $self;
22 
}
23 
 
24 
sub reset {
25 
	my ($self) = @_;
26 
 
27 
	$self = {
28 
		__file__    => $self->{__file__},
29 
		__default__ => $self->{__default__},
30 
		__eol__     => $self->{__eol__},
31 
		__append__  => $self->{__append__},
32 
	};
33 
}
34 
 
35 
sub read {
36 
	my ($self,$file,$section) = @_;
37 
 
38 
	if (!defined $file) {
39 
		$file = $self->{__file__};
40 
		return unless defined $file;
41 
	}
42 
 
43 
	return unless -e $file;
44 
 
45 
	$self->{__file__} = $file;
46 
 
47 
	open (FILE, $file);
48 
	my @lines = <FILE>;
49 
	close (FILE);
50 
	chomp @lines;
51 
 
52 
	my $data = {};
53 
	my $block = $self->{__default__} || 'default';
54 
 
55 
	foreach my $line (@lines) {
56 
		$line =~ s/\r//g;                          # Remove excess line endings
57 
		$line =~ s/\n//g;
58 
		$line =~ s/^\s+//;                         # Remove leading white space
59 
		next if $line =~ /^\s*\;/;                 # Entire comment line
60 
		next if $line =~ /^\s*\#/;
61 
		$line =~ s/\s+;.*$//;                      # Trailing comments
62 
 
63 
		next if length $line == 0;                 # Anything to do ?
64 
 
65 
#print "Read:[$block] '$line'\n";
66 
		if ($line =~ /\s*\[(.*?)\]\s*/) {
67 
			$block = $1;
68 
			next;
69 
		}
70 
 
71 
        if ( $section )
72 
        {
73 
            next unless ( $section eq $block );
74 
        }
75 
 
76 
		my ($what,$is) = split(/=/, $line, 2);
77 
		$what =~ s/^\s*//g;
78 
		$what =~ s/\s*$//g;
79 
		$is =~ s/^\s*//g;
80 
		$is =~ s/\s*$//g;
81 
 
82 
		$data->{$block}->{$what} = $is;
83 
#print "Read:[$block] '$what' '$is'\n";
84 
	}
85 
 
86 
    foreach my $block (keys %{$data}) {
87 
	    $self->{$block} = $data->{$block};
88 
    }
89 
 
90 
	return 1;
91 
}
92 
 
93 
sub write {
94 
	my ($self,$file) = @_;
95 
 
96 
	if (!defined $file) {
97 
		$file = $self->{__file__};
98 
		return unless defined $file;
99 
	}
100 
 
101 
	return unless -e $file;
102 
 
103 
	open (FILE, $file);
104 
	my @lines = <FILE>;
105 
	close (FILE);
106 
	chomp @lines;
107 
 
108 
	my $block = $self->{__default__} || 'default';
109 
	my @new = ();
110 
	my $used = {};
111 
 
112 
	foreach my $line (@lines) {
113 
		if ($line =~ /\s*\[(.*?)\]\s*/) {
114 
			$block = $1;
115 
			$line =~ s/^\s*//g;
116 
			$line =~ s/\s*$//g;
117 
			push (@new, $line);
118 
			next;
119 
		}
120 
 
121 
		if ($line =~ /^\s*\;/ || $line =~ /^\s*\#/) {
122 
			push (@new, $line);
123 
			next;
124 
		}
125 
 
126 
		if (length $line == 0) {
127 
			push (@new, '');
128 
			next;
129 
		}
130 
 
131 
		my ($what,$is) = split(/=/, $line, 2);
132 
		$what =~ s/^\s*//g;
133 
		$what =~ s/\s*$//g;
134 
		$is =~ s/^\s*//g;
135 
		$is =~ s/\s*$//g;
136 
 
137 
		if (exists $self->{$block}->{$what}) {
138 
			$line = join ('=', $what, $self->{$block}->{$what});
139 
			$used->{$block}->{$what} = 1;
140 
		}
141 
 
142 
		push (@new, $line);
143 
	}
144 
 
145 
	# Add new config variables?
146 
	if ($self->{__append__} == 1) {
147 
		foreach my $key (keys %{$self}) {
148 
			next if $key =~ /^__.*?__$/i;
149 
			print "Checking key $key (ref = " . ref($key) . ")\n";
150 
 
151 
			if (!exists $used->{$key}) {
152 
				print "Block doesn't exist!\n";
153 
				push (@new, "");
154 
				push (@new, "[$key]");
155 
			}
156 
 
157 
			foreach my $lab (keys %{$self->{$key}}) {
158 
				if (!exists $used->{$key}->{$lab}) {
159 
					print "Adding $lab=$self->{$key}->{$lab} to INI\n";
160 
					push (@new, "$lab=$self->{$key}->{$lab}");
161 
				}
162 
			}
163 
		}
164 
	}
165 
 
166 
	my $eol = $self->{__eol__} || "\r\n";
167 
	open (WRITE, ">$file");
168 
	print WRITE join ($eol, @new);
169 
	close (WRITE);
170 
 
171 
	return 1;
172 
}
173 
 
174 
sub get
175 
{
176 
    my ($self, $section, $parameter, $default ) = @_;
177 
 
178 
    if ( exists ( $self->{$section}{$parameter}  ))
179 
    {
180 
        return $self->{$section}{$parameter};
181 
    }
182 
 
183 
    return $default;
184 
}
185 
 
186 
sub set
187 
{
188 
    my ($self, $section, $parameter, $value ) = @_;
189 
    $self->{$section}{$parameter} = $value;
190 
}
191 
 
192 
 
193 
1;
194 
__END__