<commit_before># slimrat - configuration handling
#
# Copyright (c) 2009 <NAME>
#
# This file is part of slimrat, an open-source Perl scripted
# command line and GUI utility for downloading files from
# several download providers.
# 
# Permission is hereby granted, free of charge, to any person
# obtaining a copy of this software and associated documentation
# files (the "Software"), to deal in the Software without
# restriction, including without limitation the rights to use,
# copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the
# Software is furnished to do so, subject to the following
# conditions:
# 
# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Software.
# 
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
# OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
# OTHER DEALINGS IN THE SOFTWARE.
#
# Authors:
#    <NAME> <<EMAIL>-dot-besard-at-gmail-dot-com>
#

#
# Configurationuration
#

# Package name
package Configuration;

# Packages
use Class::Struct;

# Write nicely
use strict;
use warnings;

# Custom packages
# NOTE: this module cannot include any custom package (it be Log.pm, Toolbox.pm, ...) as it is
#   used by almost any package and would cause circular dependancies. Also, including Log.pm
#   wouldn't help much as the verbosity etc. hasn't been initialised yet when the configuration
#   file is being parsed (debug() statements wouldn't matter). Instead, Perls internal
#   output routines are used (warn & die).
#   If there is a sensible way to include Log.pm, please change! It'd still be somewhat useful
#   to use functions like warning() and fatal() instead of warn and die.

# A configuration item
struct(Item =>	{
		default		=>	'$',
		mutable		=>	'$',
		value		=>	'$',
});


#
# Internal routines
#

# Create a new item
sub init($$) {
	my ($self, $key) = @_;
	
	if ($self->contains($key)) {
		warn("attempt to overwrite existing key through initialisation");
		return 0;
	}
	
	my $item = new Item;
	$item->mutable(1);
	
	# Add at right spot (self or parent)
	if ($self->{_parent}) {
		$self->{_parent}->init($self->{_section} . ":" . $key);
		$self->{_items}->{$key} = $self->{_parent}->{_items}->{$self->{_section} . ":" . $key};
	} else {
		$self->{_items}->{$key} = $item;
	}
	
	return 1;
}


#
# Routines
#

# Constructor
sub new {
	my $self = {
		_items		=>	{},	# Anonymous hash
		_parent		=>	undef,
		_section	=>	undef,
	};
	bless $self, 'Configuration';
	return $self;
}

# Check if the configuration contains a specific key
sub contains($$) {
	my ($self, $key) = @_;
	if (exists $self->{_items}->{$key}) {
		return 1;
	} else {
		return 0;
	}
}

# Add a default value
sub set_default($$$) {
	my ($self, $key, $value) = @_;
	
	# Check if key already exists
	unless ($self->contains($key)) {
		$self->init($key);
	}
	
	# Update the default value
	$self->{_items}->{$key}->default($value);
}

# Get a value
sub get($$) {
	my ($self, $key) = @_;
	
	# Check if it contains the key (not present returns false)
	return 0 unless ($self->contains($key));
	
	# Return value or default
	if (defined $self->{_items}->{$key}->value) {
		return $self->{_items}->{$key}->value;
	} else {
		return $self->{_items}->{$key}->default;
	}
}

# Get the default value
sub get_default($$) {
	my ($self, $key) = @_;
	
	# Check if it contains the key (not present returns false)
	return 0 unless ($self->contains($key));
	
	# Return default
	return $self->{_items}->{$key}->default;
}

# Set a value
sub set($$$) {
	my ($self, $key, $value) = @_;
	
	# Check if contains
	if (!$self->contains($key)) {
		$self->init($key);
	}
	
	# Check if mutable
	if (! $self->{_items}->{$key}->mutable) {
		warn("attempt to modify protected key '$key'");
		return 0;
	}
	
	# Modify value
	$self->{_items}->{$key}->value($value);
	return 1;
}

# Protect an item
sub protect($$) {
	my ($self, $key) = @_;
	if ($self->contains($key)) {
		$self->{_items}->{$key}->mutable(0);
		return 1;
	}
	return 0;
}

# Read a file
sub file_read($$) {
	my ($self, $file) = @_;
	my $prepend = "";	# Used for section seperation
	open(READ, $file) || die("could not open configuration file '$file'");
	while (<READ>) {
		chomp;
		
		# Skip comments, and leading & trailing spaces
		s/#.*//;
		s/^\s+//;
		s/\s+$//;
		next unless length;
		
		# Get the key/value pair
		if (my($key, $separator, $value) = /^(.+?)\s*(=+)\s*(.+?)$/) {		# The extra "?" makes perl prefer a shorter match (to avoid "\w " keys)

			# Replace '~' with HOME of user who started slimrat
			$value =~ s#^~/#$ENV{'HOME'}/#;
			
			# Substitute negatively connoted values
			$value =~ s/^(off|none|disabled|false)$/0/i;
			
			if ($key =~ m/(:)/) {
				warn("ignored configuration entry due to protected string in key ('$1')");
			} else {
				$self->set($prepend.$key, $value);
				$self->protect($prepend.$key) if (length($separator) >= 2);
			}
		}
		
		# Get section identifier
		elsif (/^\[(.+)\]$/) {
			my $section = lc($1);
			if ($section =~ m/^\w+$/) {
				$prepend = "$section:";
			} else {
				warn("ignored non-alphanumeric subsection entry");
			}
		}
		
		# Invalid entry
		else {
			warn("ignored invalid configuration entry '$_'");
		}
	}
	close(READ);
}

# Return a section
sub section($$) {
	my ($self, $section) = @_;
	$section = lc($section);
	
	# Prohibit double (or more) hiërarchies
	return error("can only split section from top-level configuration object") if ($self->{_section});
	
	# Extract subsection
	my $config_section = new Configuration;
	foreach my $key (keys %{$self->{_items}}) {
		if ($key =~ m/^$section:(.+)$/) {
			$config_section->{_items}->{substr($key, length($section)+1)} = $self->{_items}->{$key};
		}
	}
	
	# Give the section parent access
	$config_section->{_parent} = $self;
	$config_section->{_section} = $section;
	
	return $config_section;
}

# Merge two configuration objects
sub merge($$) {
	my ($self, $complement) = @_;
	
	# Process all keys and update the complement
	foreach my $key (keys %{$self->{_items}}) {
		warn("merge call only copies defaults") if (defined $self->{_items}->{$key}->value);
		$complement->set_default($key, $self->get_default($key));
	}
	
	# Update self
	$self->{_items} = $complement->{_items};
}

# Save a value to a configuration file
sub save($$) {
	my ($self, $key, $current) = @_;	
	return error("cannot save undefined key '$key'") if (!$self->contains($key));
	my $temp = $current.".temp";
	
	# Case 1: configuration file does not exist, create new one
	if (! -f $current) {
		open(WRITE, ">$current");
		print WRITE "[" . $self->{_section} . "]\n" if (defined $self->{_section});
		print WRITE $key . " = " . $self->get($key);
		close(WRITE);
	}
	
	# Case 2: configuration file exists, re-read
	else {
		open(READ, "<$current");
		open(WRITE, ">$temp");
		
		# Look for a match and update it
		my $temp_section;
		while (<READ>) {
			chomp;
		
			# Get the key/value pair
			if (my($temp_key) = /^(.+?)\s*=+\s*.+?$/) {
				if ($key eq $temp_key) {
					if (  (defined $self->{_section} && defined $temp_section && $self->{_section} eq $temp_section)
					   || (!defined $self->{_section} && !defined $temp_section) ) {
						print WRITE $key . " = " . $self->get($key) . "\n";
						last;
					}				
				}
			}
		
			# Get section identifier
			elsif (/^\[(.+)\]$/) {
				$temp_section = lc($1);
			}
						
			print WRITE "$_\n";
		}
		
		# No match found, prepend or append key
		if (eof(READ)) {
			if (defined $self->{_section}) {
				print WRITE "\n[" . $self->{_section} . "]\n";
				print WRITE $key . " = " . $self->get($key) . "\n";
			} else {
				# Prepend, when no section defined
				seek(WRITE, 0, 0);
				seek(READ, 0, 0);
				print WRITE $key . " = " . $self->get($key) . "\n";
				print WRITE while (<READ>);
					
			}
		}
		
		# Match found, just copy rest of the file
		else {
			print WRITE while (<READ>);
		}
		
		# Clean up
		close(READ);
		close(WRITE);
		unlink $current;
		rename $temp, $current;	
	}
}

# Return
1;

__END__

=head1 NAME 

Configuration

=head1 SYNOPSIS

  use Configuration;

  # Construct the configuration handles<commit_msg>Prepend before first section.<commit_after># slimrat - configuration handling
#
# Copyright (c) 2009 <NAME>
#
# This file is part of slimrat, an open-source Perl scripted
# command line and GUI utility for downloading files from
# several download providers.
# 
# Permission is hereby granted, free of charge, to any person
# obtaining a copy of this software and associated documentation
# files (the "Software"), to deal in the Software without
# restriction, including without limitation the rights to use,
# copy, modify, merge, publish, distribute, sublicense, and/or sell
# copies of the Software, and to permit persons to whom the
# Software is furnished to do so, subject to the following
# conditions:
# 
# The above copyright notice and this permission notice shall be
# included in all copies or substantial portions of the Software.
# 
# THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
# EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
# OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
# NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
# HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
# WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
# FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
# OTHER DEALINGS IN THE SOFTWARE.
#
# Authors:
#    <NAME> <<EMAIL>-at-gmail-dot-com>
#

#
# Configurationuration
#

# Package name
package Configuration;

# Packages
use Class::Struct;

# Write nicely
use strict;
use warnings;

# Custom packages
# NOTE: this module cannot include any custom package (it be Log.pm, Toolbox.pm, ...) as it is
#   used by almost any package and would cause circular dependancies. Also, including Log.pm
#   wouldn't help much as the verbosity etc. hasn't been initialised yet when the configuration
#   file is being parsed (debug() statements wouldn't matter). Instead, Perls internal
#   output routines are used (warn & die).
#   If there is a sensible way to include Log.pm, please change! It'd still be somewhat useful
#   to use functions like warning() and fatal() instead of warn and die.

# A configuration item
struct(Item =>	{
		default		=>	'$',
		mutable		=>	'$',
		value		=>	'$',
});


#
# Internal routines
#

# Create a new item
sub init($$) {
	my ($self, $key) = @_;
	
	if ($self->contains($key)) {
		warn("attempt to overwrite existing key through initialisation");
		return 0;
	}
	
	my $item = new Item;
	$item->mutable(1);
	
	# Add at right spot (self or parent)
	if ($self->{_parent}) {
		$self->{_parent}->init($self->{_section} . ":" . $key);
		$self->{_items}->{$key} = $self->{_parent}->{_items}->{$self->{_section} . ":" . $key};
	} else {
		$self->{_items}->{$key} = $item;
	}
	
	return 1;
}


#
# Routines
#

# Constructor
sub new {
	my $self = {
		_items		=>	{},	# Anonymous hash
		_parent		=>	undef,
		_section	=>	undef,
	};
	bless $self, 'Configuration';
	return $self;
}

# Check if the configuration contains a specific key
sub contains($$) {
	my ($self, $key) = @_;
	if (exists $self->{_items}->{$key}) {
		return 1;
	} else {
		return 0;
	}
}

# Add a default value
sub set_default($$$) {
	my ($self, $key, $value) = @_;
	
	# Check if key already exists
	unless ($self->contains($key)) {
		$self->init($key);
	}
	
	# Update the default value
	$self->{_items}->{$key}->default($value);
}

# Get a value
sub get($$) {
	my ($self, $key) = @_;
	
	# Check if it contains the key (not present returns false)
	return 0 unless ($self->contains($key));
	
	# Return value or default
	if (defined $self->{_items}->{$key}->value) {
		return $self->{_items}->{$key}->value;
	} else {
		return $self->{_items}->{$key}->default;
	}
}

# Get the default value
sub get_default($$) {
	my ($self, $key) = @_;
	
	# Check if it contains the key (not present returns false)
	return 0 unless ($self->contains($key));
	
	# Return default
	return $self->{_items}->{$key}->default;
}

# Set a value
sub set($$$) {
	my ($self, $key, $value) = @_;
	
	# Check if contains
	if (!$self->contains($key)) {
		$self->init($key);
	}
	
	# Check if mutable
	if (! $self->{_items}->{$key}->mutable) {
		warn("attempt to modify protected key '$key'");
		return 0;
	}
	
	# Modify value
	$self->{_items}->{$key}->value($value);
	return 1;
}

# Protect an item
sub protect($$) {
	my ($self, $key) = @_;
	if ($self->contains($key)) {
		$self->{_items}->{$key}->mutable(0);
		return 1;
	}
	return 0;
}

# Read a file
sub file_read($$) {
	my ($self, $file) = @_;
	my $prepend = "";	# Used for section seperation
	open(READ, $file) || die("could not open configuration file '$file'");
	while (<READ>) {
		chomp;
		
		# Skip comments, and leading & trailing spaces
		s/#.*//;
		s/^\s+//;
		s/\s+$//;
		next unless length;
		
		# Get the key/value pair
		if (my($key, $separator, $value) = /^(.+?)\s*(=+)\s*(.+?)$/) {		# The extra "?" makes perl prefer a shorter match (to avoid "\w " keys)

			# Replace '~' with HOME of user who started slimrat
			$value =~ s#^~/#$ENV{'HOME'}/#;
			
			# Substitute negatively connoted values
			$value =~ s/^(off|none|disabled|false)$/0/i;
			
			if ($key =~ m/(:)/) {
				warn("ignored configuration entry due to protected string in key ('$1')");
			} else {
				$self->set($prepend.$key, $value);
				$self->protect($prepend.$key) if (length($separator) >= 2);
			}
		}
		
		# Get section identifier
		elsif (/^\[(.+)\]$/) {
			my $section = lc($1);
			if ($section =~ m/^\w+$/) {
				$prepend = "$section:";
			} else {
				warn("ignored non-alphanumeric subsection entry");
			}
		}
		
		# Invalid entry
		else {
			warn("ignored invalid configuration entry '$_'");
		}
	}
	close(READ);
}

# Return a section
sub section($$) {
	my ($self, $section) = @_;
	$section = lc($section);
	
	# Prohibit double (or more) hiërarchies
	return error("can only split section from top-level configuration object") if ($self->{_section});
	
	# Extract subsection
	my $config_section = new Configuration;
	foreach my $key (keys %{$self->{_items}}) {
		if ($key =~ m/^$section:(.+)$/) {
			$config_section->{_items}->{substr($key, length($section)+1)} = $self->{_items}->{$key};
		}
	}
	
	# Give the section parent access
	$config_section->{_parent} = $self;
	$config_section->{_section} = $section;
	
	return $config_section;
}

# Merge two configuration objects
sub merge($$) {
	my ($self, $complement) = @_;
	
	# Process all keys and update the complement
	foreach my $key (keys %{$self->{_items}}) {
		warn("merge call only copies defaults") if (defined $self->{_items}->{$key}->value);
		$complement->set_default($key, $self->get_default($key));
	}
	
	# Update self
	$self->{_items} = $complement->{_items};
}

# Save a value to a configuration file
sub save($$) {
	my ($self, $key, $current) = @_;	
	return error("cannot save undefined key '$key'") if (!$self->contains($key));
	my $temp = $current.".temp";
	
	# Case 1: configuration file does not exist, create new one
	if (! -f $current) {
		open(WRITE, ">$current");
		print WRITE "[" . $self->{_section} . "]\n" if (defined $self->{_section});
		print WRITE $key . " = " . $self->get($key);
		close(WRITE);
	}
	
	# Case 2: configuration file exists, re-read
	else {
		open(READ, "<$current");
		open(WRITE, ">$temp");
		
		# Look for a match and update it
		my $temp_section;
		while (<READ>) {
			chomp;
		
			# Get the key/value pair
			if (my($temp_key) = /^(.+?)\s*=+\s*.+?$/) {
				if ($key eq $temp_key) {
					if (  (defined $self->{_section} && defined $temp_section && $self->{_section} eq $temp_section)
					   || (!defined $self->{_section} && !defined $temp_section) ) {
						print WRITE $key . " = " . $self->get($key) . "\n";
						last;
					}				
				}
			}
		
			# Get section identifier
			elsif (/^\[(.+)\]$/) {
				$temp_section = lc($1);
			}
						
			print WRITE "$_\n";
		}
		
		# No match found, prepend or append key
		if (eof(READ)) {
			if (defined $self->{_section}) {
				print WRITE "\n[" . $self->{_section} . "]\n";
				print WRITE $key . " = " . $self->get($key) . "\n";
			} else {
				# Prepend before first section, when not defined
				seek(WRITE, 0, 0);
				seek(READ, 0, 0);
				my $written = 0;
				while (<READ>) {
					if (!$written && /^\[(.+)\]$/) {
						print WRITE $key . " = " . $self->get($key) . "\n";
						$written = 1;
					}
					print WRITE;
				}
				print WRITE $key . " = " . $self->get($key) . "\n" unless ($written);					
			}
		}
		
		# Match found, just copy rest of the file
		else {
			print WRITE while (<READ>);
		}
		
		# Clean up
		close(READ);
		close(WRITE);
		unlink $current;
		rename $temp, $current;	
	}
}

# Return
1;

__END__

=head1 NAME 

Configuration

=head1 SYNOPSIS

  use Configuration;

  # Construct the configuration handles
{'fraction_non_alphanumeric': 0.17333488183032345, 'fraction_numerical': 0.003716392776261541, 'mean_word_length': 3.3566911206678474, 'pattern_counts': {'":': 4, '<': 21, '<?xml version=': 0, '>': 194, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 4, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5653303', 'n_tokens_mistral': 6569, 'n_tokens_neox': 5852, 'n_words': 1862}