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 # 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 # 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. # for loading and saving configurations, and pulling config data from a database.
# Meaningful options for this are: # Meaningful options for args 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. # - `quote_values` If set to a non-empty string, this string is used to quote values
# You may also pass in one or more initial configuration settings. # 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. # @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. # @return A new Webperl::ConfigMicro object, or undef if a problem occured.
sub new { sub new {
my $invocant = shift; my $invocant = shift;
my $class = ref($invocant) || $invocant; my $class = ref($invocant) || $invocant;
my $filename = shift; my $filename = shift;
my $self = $class -> SUPER::new(minimal => 1, # minimal tells SystemModule to skip object checks my $self = $class -> SUPER::new(minimal => 1, # minimal tells SystemModule to skip object checks
"__privdata" => { "modified" => 0 }, quote_values => '"',
inline_comments => 1,
@_) @_)
or return undef; or return undef;
@ -115,7 +123,7 @@ sub read {
# TODO: should this return the whole name? Possibly a security issue here # TODO: should this return the whole name? Possibly a security issue here
return $self -> self_error("Failed to open '$filename': $!") return $self -> self_error("Failed to open '$filename': $!")
if(!open(CFILE, "< $filename")); if(!open(CFILE, "<:utf8", $filename));
my $counter = 0; my $counter = 0;
while(my $line = <CFILE>) { while(my $line = <CFILE>) {
@ -135,10 +143,16 @@ sub read {
$self -> {$section} -> {$1} = $2; $self -> {$section} -> {$1} = $2;
# Handle attributes without quoted values - # or ; at any point will mark comments # 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; my $key = $1;
$self -> {$section} -> {$key} = $2; $self -> {$section} -> {$key} = $2;
$self -> {$section} -> {$key} =~ s/^\s*(.*?)\s*$/$1/; $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... # bad input...
} else { } else {
close(CFILE); 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. # Create a text version of the configuration stored in this ConfigMicro object.
# This creates a string representation of the configuration suitable for writing to # This creates a string representation of the configuration suitable for writing to
# an ini file or otherwise printing. # 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 # @param skip If you specify one or more section names, the sections will not be
# added to the string generated by this function. # added to the string generated by this function.
# @return A string representation of this ConfigMicro's config settings. # @return A string representation of this ConfigMicro's config settings.
sub text_config { sub as_text {
my $self = shift; my $self = shift;
my @skip = @_; my @skip = @_;
my $result; my $result;
@ -168,7 +182,7 @@ sub text_config {
my ($key, $skey); my ($key, $skey);
foreach $key (sort(keys(%$self))) { foreach $key (sort(keys(%$self))) {
# Skip the internal settings # 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! # 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)); next if(scalar(@skip) && grep($key, @skip));
@ -177,9 +191,16 @@ sub text_config {
# with no section header. # with no section header.
$result .= "[$key]\n" if($key ne "_"); $result .= "[$key]\n" if($key ne "_");
# write out all the key/value pairs in the current section my $fieldwidth = $self -> _longest_key($self -> {$key});
foreach $skey (sort(keys(%{$self -> {$key}}))) { if($fieldwidth) {
$result .= $skey." = \"".$self -> {$key} -> {$skey}."\"\n"; # 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"; $result .= "\n";
} }
@ -201,13 +222,10 @@ sub write {
my $filename = shift or return set_error("No file name provided"); my $filename = shift or return set_error("No file name provided");
my @skip = @_; 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': $!") 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); 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; 1;