[Bps-public-commit] Config-GitLike branch, master, updated. 8f1bb6176435a1b29fc93920b7c2d373fa752adc
spang at bestpractical.com
spang at bestpractical.com
Thu May 28 08:51:17 EDT 2009
The branch, master has been updated
via 8f1bb6176435a1b29fc93920b7c2d373fa752adc (commit)
via 850458564a4526521ab552120d800f29edb446c1 (commit)
via 0383a69ea795ade3995e52a1b9b65e228a30d79b (commit)
via a2a72847d9c7911be35db58f0663e28befbf4eb1 (commit)
via cc56feadb55c93c0c006dfe4ba2b8ea8d010d3f7 (commit)
from fd0c07e18d17a58949a4434e7099e639e8e7e2dd (commit)
Summary of changes:
lib/Config/GitLike.pm | 169 +++++++++++++++++++++++++++++++++++++++-
lib/Config/GitLike/Cascaded.pm | 35 ++++++++
2 files changed, 200 insertions(+), 4 deletions(-)
- Log -----------------------------------------------------------------
commit cc56feadb55c93c0c006dfe4ba2b8ea8d010d3f7
Author: Christine Spang <spang at mit.edu>
Date: Thu May 28 11:40:56 2009 -0400
some pod while I'm figuring out how this stuff works anyway
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 5b17bed..af95912 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -34,8 +34,21 @@ has 'multiple' => (
Config::GitLike - git-compatible config file parsing
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
=cut
+=head2 set_multiple $name
+
+Mark the key string C<$name> as containing multiple values.
+
+Returns nothing.
+
+=cut
sub set_multiple {
my $self = shift;
@@ -43,12 +56,29 @@ sub set_multiple {
$self->multiple->{$name} = $mult;
}
+=head2 is_multiple $name
+
+Return a true value if the key string C<$name> contains multiple values; false
+otherwise.
+
+=cut
+
sub is_multiple {
my $self = shift;
my $name = shift;
return $self->multiple->{$name};
}
+=head2 load
+
+Load the global, local, and directory configuration file with the filename
+C<confname> into the C<data> attribute (if they exist).
+
+Returns the contents of the C<data> attribute after all configs have been
+loaded.
+
+=cut
+
sub load {
my $self = shift;
my $path = shift || Cwd::cwd;
@@ -59,11 +89,34 @@ sub load {
return $self->data;
}
+=head2 dir_file
+
+Return a string representing the path to a configuration file with the
+name C<confname> in the current working directory (or a directory higher
+on the directory tree).
+
+Override this method in a subclass if the directory file has a name
+other than C<confname> or is contained in, for example, a subdirectory
+(such as with C<./.git/config> versus C<~/.gitconfig>).
+
+=cut
+
sub dir_file {
my $self = shift;
return "." . $self->confname;
}
+=head2 load_dirs
+
+Load the configuration file in the current working directory into the C<data>
+attribute or, if there is no config matching C<dir_file> in the current working
+directory, walk up the directory tree until one is found. (No error is thrown
+if none is found.)
+
+Returns nothing of note.
+
+=cut
+
sub load_dirs {
my $self = shift;
my $path = shift;
@@ -79,28 +132,77 @@ sub load_dirs {
}
}
+=head2 global_file
+
+Return a string representing the path to a system-wide configuration file with
+name C<confname> (the L<Config::GitLike> object's C<confname> attribute).
+
+Override this method in a subclass if the global file has a different name
+than C<confname> or is contained in a directory other than C</etc>.
+
+=cut
+
sub global_file {
my $self = shift;
return "/etc/" . $self->confname;
}
+=head2 load_global
+
+If a global configuration file with the name C<confname> exists, load
+its configuration variables into the C<data> attribute.
+
+Returns the current contents of the C<data> attribute after the
+file has been loaded, or undef if no global config file is found.
+
+=cut
+
sub load_global {
my $self = shift;
return unless -e $self->global_file;
return $self->load_file( $self->global_file );
}
+=head2 user_file
+
+Return a string representing the path to a configuration file
+in the current user's home directory with filename C<confname>.
+
+Override this method in a subclass if the user directory file
+does not have the same name as the global config file.
+
+=cut
+
sub user_file {
my $self = shift;
return File::Spec->catfile( File::HomeDir->my_home, "." . $self->confname );
}
+=head2 load_user
+
+If a configuration file with the name C<confname> exists in the current
+user's home directory, load its config variables into the C<data>
+attribute.
+
+Returns the current contents of the C<data> attribute after the file
+has been loaded, or undef if no global config file is found.
+
+=cut
+
sub load_user {
my $self = shift;
return unless -e $self->user_file;
return $self->load_file( $self->user_file );
}
+=head2 load_file $filename
+
+Takes a string containing the path to a file, opens it if it exists, loads its
+config variables into the C<data> attribute, and returns the current contents
+of the C<data> attribute (a hashref).
+
+=cut
+
sub load_file {
my $self = shift;
my ($filename) = @_;
@@ -120,6 +222,27 @@ sub load_file {
return $self->data;
}
+=head2 parse_content( content = $str, callback = $sub, error = $sub )
+
+Takes arguments consisting of C<content>, a string of the content of the
+configuration file to be parsed, C<callback>, a submethod to run on information
+retrieved from the config file (headers, subheaders, and key/value pairs), and
+C<error>, a submethod to run on malformed content.
+
+Returns undef on success and C<error($content)> on failure.
+
+C<callback> is called like:
+
+ callback(section => $str, offset => $num, length $num, name => $str, value => $str)
+
+C<name> and C<value> may be omitted if the callback is not being called on a
+key/value pair, or if it is being called on a key with no value.
+
+C<error> is called like:
+
+ error($content)
+
+=cut
sub parse_content {
my $self = shift;
@@ -227,6 +350,18 @@ sub cast {
}
}
+=head2 get( key => $str, as => $type )
+
+Retrieve the config value associated with C<key> cast as an C<as>.
+
+The C<key> option is required (will return a string by default); the C<as>
+option is not (will return undef if unspecified).
+
+Loads the configuration file with name $confname if it hasn't yet been
+loaded.
+
+=cut
+
sub get {
my $self = shift;
my %args = @_;
commit a2a72847d9c7911be35db58f0663e28befbf4eb1
Author: Christine Spang <spang at mit.edu>
Date: Thu May 28 11:41:47 2009 -0400
a billion regexes without comments make me want to cry
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index af95912..4a2c4ff 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -252,11 +252,16 @@ sub parse_content {
my($section, $prev) = (undef, '');
while (1) {
+ # drop leading blank lines
$c =~ s/\A\s*//im;
my $offset = $length - length($c);
+ # drop lines that start with a comment
if ($c =~ s/\A[#;].*?$//im) {
next;
+ # [sub]section headers of the format [section "subsection"] (with
+ # unlimited whitespace between). any characters that appear
+ # after the closing square bracket are ignored.
} elsif ($c =~ s/\A\[([0-9a-z.-]+)(?:[\t ]*"(.*?)")?\]//im) {
$section = lc $1;
$section .= ".$2" if defined $2;
@@ -265,6 +270,8 @@ sub parse_content {
offset => $offset,
length => ($length - length($c)) - $offset,
);
+ # keys followed by a unlimited whitespace and (optionally) a comment
+ # (no value)
} elsif ($c =~ s/\A([0-9a-z-]+)[\t ]*([#;].*)?$//im) {
$args{callback}->(
section => $section,
@@ -272,34 +279,51 @@ sub parse_content {
offset => $offset,
length => ($length - length($c)) - $offset,
);
+ # key/value pairs (this particular regex matches only the key part and
+ # the =, with unlimited whitespace around the =)
} elsif ($c =~ s/\A([0-9a-z-]+)[\t ]*=[\t ]*//im) {
my $name = $1;
my $value = "";
while (1) {
+ # concatenate whitespace
if ($c =~ s/\A[\t ]+//im) {
$value .= ' ';
+ # line continuation (\ character proceeded by new line)
} elsif ($c =~ s/\A\\\r?\n//im) {
next;
+ # comment
} elsif ($c =~ s/\A([#;].*?)?$//im) {
last;
+ # escaped quote characters are part of the value
} elsif ($c =~ s/\A\\(['"])//im) {
$value .= $1;
+ # escaped newline in config is translated to actual newline
} elsif ($c =~ s/\A\\n//im) {
$value .= "\n";
+ # escaped tab in config is translated to actual tab
} elsif ($c =~ s/\A\\t//im) {
$value .= "\t";
+ # escaped backspace in config is translated to actual backspace
} elsif ($c =~ s/\A\\b//im) {
$value .= "\b";
+ # valid value (possibly containing escape codes)
} elsif ($c =~ s/\A"([^"\\]*(?:(?:\\\n|\\[tbn"\\])[^"\\]*)*)"//im) {
my $v = $1;
+ # remove all continuations (\ followed by a newline)
$v =~ s/\\\n//g;
+ # swap escaped newlines with actual newlines
$v =~ s/\\n/\n/g;
+ # swab escaped tabs with actual tabs
$v =~ s/\\t/\t/g;
+ # swap escaped backspaces with actual backspaces
$v =~ s/\\b/\b/g;
+ # swap escaped \ with actual \
$v =~ s/\\\\/\\/g;
$value .= $v;
+ # valid value (no escape codes)
} elsif ($c =~ s/\A([^\t \\\n]+)//im) {
$value .= $1;
+ # unparseable
} else {
return $args{error}->($c);
}
@@ -311,8 +335,10 @@ sub parse_content {
offset => $offset,
length => ($length - length($c)) - $offset,
);
+ # end of content string; all done now
} elsif (not length $c) {
last;
+ # unparseable
} else {
return $args{error}->($c);
}
commit 0383a69ea795ade3995e52a1b9b65e228a30d79b
Author: Christine Spang <spang at mit.edu>
Date: Thu May 28 11:42:36 2009 -0400
stick an __END__ where the code ends and only doc remains
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 4a2c4ff..bd2b647 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -555,6 +555,10 @@ sub set {
or die "Can't rename $args{filename}.lock to $args{filename}: $!\n";
}
+1;
+
+__END__
+
=head1 LICENSE
You may modify and/or redistribute this software under the same terms
@@ -567,7 +571,3 @@ Copyright 2009 Best Practical Solutions, LLC
=head1 AUTHOR
Alex Vandiver <alexmv at bestpractical.com>
-
-=cut
-
-1;
commit 850458564a4526521ab552120d800f29edb446c1
Author: Christine Spang <spang at mit.edu>
Date: Thu May 28 11:49:36 2009 -0400
pod Config::GitLike::Cascaded as well
diff --git a/lib/Config/GitLike/Cascaded.pm b/lib/Config/GitLike/Cascaded.pm
index f637eb2..9861547 100644
--- a/lib/Config/GitLike/Cascaded.pm
+++ b/lib/Config/GitLike/Cascaded.pm
@@ -9,6 +9,16 @@ use File::Spec;
extends 'Config::GitLike';
+=head2 load_dirs
+
+Load the configuration files in the directory tree, starting with the root
+directory and walking up to the current working directory. (No error is thrown
+if no config files are found.)
+
+Returns nothing of note.
+
+=cut
+
sub load_dirs {
my $self = shift;
my $path = shift;
commit 8f1bb6176435a1b29fc93920b7c2d373fa752adc
Author: Christine Spang <spang at mit.edu>
Date: Thu May 28 12:00:14 2009 -0400
more doc love
diff --git a/lib/Config/GitLike/Cascaded.pm b/lib/Config/GitLike/Cascaded.pm
index 9861547..8cba395 100644
--- a/lib/Config/GitLike/Cascaded.pm
+++ b/lib/Config/GitLike/Cascaded.pm
@@ -9,6 +9,16 @@ use File::Spec;
extends 'Config::GitLike';
+=head1 NAME
+
+Config::GitLike::Cascaded - git-like config file parsing with cascaded inheritance
+
+=head1 SYNOPSIS
+
+=head1 DESCRIPTION
+
+=head1 METHODS
+
=head2 load_dirs
Load the configuration files in the directory tree, starting with the root
@@ -34,3 +44,18 @@ __PACKAGE__->meta->make_immutable;
no Moose;
1;
+
+__END__
+
+=head1 LICENSE
+
+You may modify and/or redistribute this software under the same terms
+as Perl 5.8.8.
+
+=head1 COPYRIGHT
+
+Copyright 2009 Best Practical Solutions, LLC
+
+=head1 AUTHOR
+
+Alex Vandiver <alexmv at bestpractical.com>
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list