view release on metacpan or  search on metacpan

Prima/IniFile.pm  view on Meta::CPAN

sub create
{
	my $class = shift;
	my %profile;
	%profile = @_ if scalar(@_)%2==0;
	%profile = (file => shift) if scalar(@_)%2==1;
	%profile = (%profile, @_) if scalar(@_)%2==0;
	my $self = {};
	bless( $self, $class);
	$self-> clean;
	$self-> {fileName} = $profile{-file} if exists $profile{-file};
	$self-> {fileName} = $profile{file} if exists $profile{file};
	$self-> read($self-> {fileName}, %profile) if exists $self-> {fileName};
	return $self;
}

sub DESTROY
{
	my $self = shift;
	$self-> write;
}

sub canonicalize_fname
{
	my $p = shift;
	return Cwd::abs_path($p) if -d $p;
	my $dir = $p;
	my $fn;
	if ($dir =~ s{[/\\]([^\\/]+)$}{}) {
		$fn = $1;
	} else {
		$fn = $p;
		$dir = '.';
	}
	unless ( scalar( stat $dir)) {
		$dir = "";
	} else {
		$dir = eval { Cwd::abs_path($dir) };
		$dir = "." if $@;
		$dir = "" unless -d $dir;
		$dir =~ s/(\\|\/)$//;
	}
	return "$dir/$fn";
}

sub read
{
	my ($self, $fname, %profile) = @_;
	$self-> write;             # save the old contents
	$self-> clean;
	$self-> {fileName} = canonicalize_fname($fname);
	eval
	{
		my $f;
		open $f, "<", $fname or do
		{
			open $f, ">", $fname or die "Cannot create $fname: $!\n";
			close $f;
			open $f, "<", $fname or die "Cannot open $fname: $!\n";
		};
		binmode $f, ":utf8";
		my @chunks;
		my %sectionChunks = ('' => [0]);
		my %sectionItems = ('' => []);
		my $currentChunk = [];
		my $items = {};
		my $chunkNum = 0;
		my $line = 0;
		push @chunks, $currentChunk;
		push @{$sectionItems{''}}, $items;
		while (<$f>)
		{
			chomp;
			if ( /^\s*\[(.*?)\]/)         # new section?
			{
				my $section = $1;
				$currentChunk = [];
				$items = {};
				push @chunks, $currentChunk;
				$chunkNum++;
				$line = 0;
				if ( exists $sectionChunks{$section})
				{
					push @{$sectionChunks{$section}}, $chunkNum;
					push @{$sectionItems{$section}}, $items;
				}
				else
				{
					$sectionChunks{$section} = [$chunkNum];
					$sectionItems{$section} = [$items];
				}
				next;
			}
			next   if /^\s*[;#]/;      # comment
			next   unless /^\s*(.*?)\s*=/;
			# another value found
			my $item = $1;
			if ( exists $items-> {$item})
			{
				# duplicate
				push @{$items-> {$item}}, $line;
			}
			else
			{
				# first such $item in this portion of the $section
				$items-> {$item} = [$line];
			}
		}
		continue
		{
			push( @$currentChunk, $_);
			$line++;
		}
		close $f;
		push( @{$chunks[-1]}, '') if scalar(@{$chunks[-1]}) && $chunks[-1]-> [-1] !~ /^\s*$/;
		$self-> {chunks} = [@chunks];
		$self-> {sectionChunks} = {%sectionChunks};
		$self-> {sectionItems} = {%sectionItems};

		# default values
		my $def;

Prima/IniFile.pm  view on Meta::CPAN

	$self-> {ini}-> replace_values($self-> {section}, $item, ref($val) eq q/ARRAY/ ? @$val : ($val));
}

sub DELETE
{
	my ($self, $item) = @_;
	$self-> {ini}-> replace_values($self-> {section}, $item);
}

sub CLEAR         # Well, dangerous
{
	my $self = $_[0];
	my @items = $self-> {ini}-> items($self-> {section});
	for (@items)
	{
		$self-> {ini}-> replace_values($self-> {section}, $_);
	}
}

sub EXISTS
{
	my ($self, $item) = @_;
	return $self-> {ini}-> nvalues($self-> {section},$item) > 0;
}

sub FIRSTKEY
{
	my $self = $_[0];
	$self-> {iterator} = [$self-> {ini}-> items($self-> {section})];
	return $self-> NEXTKEY;
}

sub NEXTKEY
{
	my $self = $_[0];
	unless ( exists $self-> {iterator} && scalar @{$self-> {iterator}})
	{
		return wantarray ? () : undef;
	}
	my $key = shift @{$self-> {iterator}};
	return wantarray ? ($key, $self-> FETCH($key)) : $key;
}

package Prima::IniFile;

sub section
{
	my %tied;
	tie %tied, q/Prima::IniFile::Section::Helper::to::Tie/, $_[0], $_[1];
	return \%tied;
}

sub write
{
	my $self = $_[0];
	return unless defined($self-> {fileName}) && $self-> {changed};
	my $fname = $self-> {fileName};
	eval {
		my $f;
		open $f, ">", $fname or die "Cannot write to the $fname: $!\n";
		binmode $f, ":utf8";
		pop @{$self-> {chunks}-> [-1]} if scalar(@{$self-> {chunks}-> [-1]}) && $self-> {chunks}-> [-1]-> [-1] =~ /^\s*$/;
		for ( @{$self-> {chunks}})
		{
			for (@$_) { print $f "$_\n" }
		}
		push( @{$self-> {chunks}-> [-1]}, '') if scalar(@{$self-> {chunks}-> [-1]}) && $self-> {chunks}-> [-1]-> [-1] !~ /^\s*$/;
		close $f;
	};
	$self-> {changed} = undef if $@;
	warn($@) if $@;
}

1;

=pod

=head1 NAME

Prima::IniFile - support of Windows-like initialization files

=head1 DESCRIPTION

The module contains a class, that provides mapping of text initialization file to
a two-level hash structure. The first level
is called sections, which groups the second level hashes, called items.
Sections must have unique keys. The items hashes values are arrays of
text strings. The methods, operated on these arrays are L<get_values>,
L<set_values>, L<add_values> and L<replace_values>.

=head1 SYNOPSIS

	use Prima::IniFile;

	my $ini = create Prima::IniFile;
	my $ini = create Prima::IniFile FILENAME;
	my $ini = create Prima::IniFile FILENAME,
					default => HASHREF_OR_ARRAYREF;
	my $ini = create Prima::IniFile file => FILENAME,
					default => HASHREF_OR_ARRAYREF;

	my @sections = $ini->sections;
	my @items = $ini->items(SECTION);
	my @items = $ini->items(SECTION, 1);
	my @items = $ini->items(SECTION, all => 1);

	my $value = $ini-> get_values(SECTION, ITEM);
	my @vals = $ini-> get_values(SECTION, ITEM);
	my $nvals = $ini-> nvalues(SECTION, ITEM);

	$ini-> set_values(SECTION, ITEM, LIST);
	$ini-> add_values(SECTION, ITEM, LIST);
	$ini-> replace_values(SECTION, ITEM, LIST);

	$ini-> write;
	$ini-> clean;
	$ini-> read( FILENAME);
	$ini-> read( FILENAME, default => HASHREF_OR_ARRAYREF);

	my $sec = $ini->section(SECTION);
	$sec->{ITEM} = VALUE;