Chris/webperl
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Overhaul to make this actually useful for saving configs.

Browse Source
This commit is contained in:
Chris 2013-09-19 23:10:52 +01:00
parent 2ebee7fa82
commit 3fb28754d7
1 changed files with 58 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

78
Webperl/ConfigMicro.pm
View File

@ -69,21 +69,29 @@ use DBI;
# ============================================================================
# Constructor and basic file-based config functions
## @cmethod $ new(%args)
## @cmethod $ new($filename, %args)
# Create a new Webperl::ConfigMicro object. This creates an object that provides functions
# for loading and saving configurations, and pulling config data from a database.
# Meaningful options for this are:
# filename - The name of the configuration file to read initial settings from. This
# is optional, and if not specified you will get an empty object back.
# You may also pass in one or more initial configuration settings.
# Meaningful options for args are:
#
# - `quote_values` If set to a non-empty string, this string is used to quote values
# written as part of as_text() or write(). The default is '"'. If
# this is set to an empty string, values are not quoted.
# - `inline_comments` If true (the default), comments may be included in values. If
# this is set to false, # and ; in values are treated as literals and
# not as comments.
#
# @param filename The name of the configuration file to read initial settings from. This
# is optional, and if not specified you will get an empty object back.
# @param args A hash of key, value pairs to initialise the object with.
# @return A new Webperl::ConfigMicro object, or undef if a problem occured.
sub new {
my $invocant = shift;
my $class = ref($invocant) || $invocant;
my $filename = shift;
my $self = $class -> SUPER::new(minimal => 1, # minimal tells SystemModule to skip object checks
"__privdata" => { "modified" => 0 },
my $self = $class -> SUPER::new(minimal => 1, # minimal tells SystemModule to skip object checks
quote_values => '"',
inline_comments => 1,
@_)
or return undef;
@ -115,7 +123,7 @@ sub read {
# TODO: should this return the whole name? Possibly a security issue here
return $self -> self_error("Failed to open '$filename': $!")
if(!open(CFILE, "< $filename"));
if(!open(CFILE, "<:utf8", $filename));
my $counter = 0;
while(my $line = <CFILE>) {
@ -135,10 +143,16 @@ sub read {
$self -> {$section} -> {$1} = $2;
# Handle attributes without quoted values - # or ; at any point will mark comments
} elsif($line =~ /^\s*([\w:-]+)\s*=\s*([^\#;]+)/ ) {
} elsif(!$self -> {"inline_comments"} && $line =~ /^\s*([\w:-]+)\s*=\s*(.+)$/ ) {
my $key = $1;
$self -> {$section} -> {$key} = $2;
$self -> {$section} -> {$key} =~ s/^\s*(.*?)\s*$/$1/;
} elsif($self -> {"inline_comments"} && $line =~ /^\s*([\w:-]+)\s*=\s*([^;#]+)/ ) {
my $key = $1;
$self -> {$section} -> {$key} = $2;
$self -> {$section} -> {$key} =~ s/^\s*(.*?)\s*$/$1/;
# bad input...
} else {
close(CFILE);
@ -152,7 +166,7 @@ sub read {
}
## @method $ text_config(@skip)
## @method $ as_text(@skip)
# Create a text version of the configuration stored in this ConfigMicro object.
# This creates a string representation of the configuration suitable for writing to
# an ini file or otherwise printing.
@ -160,7 +174,7 @@ sub read {
# @param skip If you specify one or more section names, the sections will not be
# added to the string generated by this function.
# @return A string representation of this ConfigMicro's config settings.
sub text_config {
sub as_text {
my $self = shift;
my @skip = @_;
my $result;
@ -168,7 +182,7 @@ sub text_config {
my ($key, $skey);
foreach $key (sort(keys(%$self))) {
# Skip the internal settings
next if($key eq "__privdata");
next unless(ref($self -> {$key}) eq "HASH");
# If we have any sections to skip, and the key is one of the ones to skip... skip!
next if(scalar(@skip) && grep($key, @skip));
@ -177,9 +191,16 @@ sub text_config {
# with no section header.
$result .= "[$key]\n" if($key ne "_");
# write out all the key/value pairs in the current section
foreach $skey (sort(keys(%{$self -> {$key}}))) {
$result .= $skey." = \"".$self -> {$key} -> {$skey}."\"\n";
my $fieldwidth = $self -> _longest_key($self -> {$key});
if($fieldwidth) {
# write out all the key/value pairs in the current section
foreach $skey (sort(keys(%{$self -> {$key}}))) {
$result .= $skey.(" " x (($fieldwidth - length($skey)) + 1))."= ";
$result .= $self -> {"quote_values"} if($self -> {"quote_values"});
$result .= $self -> {$key} -> {$skey};
$result .= $self -> {"quote_values"} if($self -> {"quote_values"});
$result .= "\n";
}
}
$result .= "\n";
}
@ -201,13 +222,10 @@ sub write {
my $filename = shift or return set_error("No file name provided");
my @skip = @_;
# Do nothing if the config has not been modified.
return 0 if(!$self -> {"__privdata"} -> {"modified"});
return $self -> self_error("Failed to save '$filename': $!")
if(!open(CFILE, "> $filename"));
if(!open(CFILE, ">:utf8", $filename));
print CFILE $self -> text_config(@skip);
print CFILE $self -> as_text(@skip);
close(CFILE);
@ -358,5 +376,25 @@ sub set_db_config {
}
# ============================================================================
# Private functions
## @method private $ _longest_key($hashref)
# Determine the length of the longest key string in the specified hashref.
#
# @param hashref A reference to a hash to get the longest key length for
# @return The longest key length, 0 if the hashref is empty
sub _longest_key {
my $self = shift;
my $hashref = shift;
my $longest = 0;
foreach my $key (keys(%{$hashref})) {
$longest = length($key)
if(length($key) > $longest);
}
return $longest;
}
1;