[Bps-public-commit] Config-GitLike branch, master, updated. 1.08-13-g90ef3ed
Alex Vandiver
alexmv at bestpractical.com
Sat Aug 4 16:56:00 EDT 2012
The branch, master has been updated
via 90ef3ed1b9667eb3d9b897e408b0da777607317c (commit)
via e539e9eb55ab3dc9789fc9041af73ef15e6499c4 (commit)
from 6fe9ebb1b00c7a329f7f901e2955d08953a28ece (commit)
Summary of changes:
lib/Config/GitLike.pm | 20 +++++++-
t/comment.t | 17 ++----
t/encoding.t | 42 +++++++++++++++
t/lib/TestConfig.pm | 18 +++++++
t/t1300-repo-config.t | 139 ++++++++++++++++++--------------------------------
5 files changed, 134 insertions(+), 102 deletions(-)
create mode 100644 t/encoding.t
- Log -----------------------------------------------------------------
commit e539e9eb55ab3dc9789fc9041af73ef15e6499c4
Author: David E. Wheeler <david at justatheory.com>
Date: Wed Aug 1 16:21:15 2012 +0200
Add the "encoding" attribute and use it.
To encode and decode config files. Necessary because, if no encoding is
specified, and a UTF-8 string is saved to a config file, when it is read back
in, it will not be properly read as UTF-8. The same would go for any coding
other than Latin-1 (maybe).
diff --git a/lib/Config/GitLike.pm b/lib/Config/GitLike.pm
index 2728a89..158b3f0 100644
--- a/lib/Config/GitLike.pm
+++ b/lib/Config/GitLike.pm
@@ -58,6 +58,11 @@ has 'cascade' => (
default => 0,
);
+has 'encoding' => (
+ is => 'rw',
+ isa => 'Maybe[Str]',
+);
+
sub set_multiple {
my $self = shift;
my ($name, $mult) = (@_, 1);
@@ -135,6 +140,9 @@ sub _read_config {
return unless -f $filename and -r $filename;
open(my $fh, '<', $filename) or return;
+ if (my $encoding = $self->encoding) {
+ binmode $fh, ":encoding($encoding)";
+ }
my $c = do {local $/; <$fh>};
@@ -1007,6 +1015,9 @@ sub _write_config {
# way git does it)
sysopen(my $fh, "${filename}.lock", O_CREAT|O_EXCL|O_WRONLY)
or die "Can't open ${filename}.lock for writing: $!\n";
+ if (my $encoding = $self->encoding) {
+ binmode $fh, ":encoding($encoding)";
+ }
print $fh $content;
close $fh;
@@ -1328,7 +1339,7 @@ Now, on the the methods!
There are the methods you're likely to use the most.
-=head2 new( confname => 'config' )
+=head2 new( confname => 'config', encoding => 'UTF-8' )
Create a new configuration object with the base config name C<confname>.
If you are interested simply in loading one specific file, and not in
@@ -1349,6 +1360,13 @@ git can read or write, pass in C<compatible =E<gt> 1> to this
constructor. The default rules for some components of the config
file are more permissive than git's (see L<"DIFFERENCES FROM GIT-CONFIG">).
+If you know that your Git config files are encoded with a known
+character encoding, pass in C<encoding =E<gt> $encoding> to specify the
+name of the encoding. Config::GitLike will then properly serialize and
+deserialize the files with that encoding. Note that configutation files
+written with C<git config> are usually, but are not required to be, in
+UTF-8.
+
=head2 confname
The configuration filename that you passed in when you created
diff --git a/t/encoding.t b/t/encoding.t
new file mode 100644
index 0000000..c3b7b75
--- /dev/null
+++ b/t/encoding.t
@@ -0,0 +1,49 @@
+use strict;
+use warnings;
+
+use Test::More;
+use File::Spec;
+use File::Temp qw/tempdir/;
+use lib 't/lib';
+use TestConfig;
+
+my $config_dirname = tempdir( CLEANUP => !$ENV{CONFIG_GITLIKE_DEBUG} );
+my $config_filename = File::Spec->catfile( $config_dirname, 'config' );
+
+diag "config file is: $config_filename" if $ENV{TEST_VERBOSE};
+
+my $config = TestConfig->new(
+ confname => 'config',
+ tmpdir => $config_dirname,
+ encoding => 'UTF-8',
+);
+$config->load;
+
+UTF8: {
+ use utf8;
+ $config->set(
+ key => 'core.penguin',
+ value => 'little blüe',
+ filename => $config_filename
+ );
+}
+
+my $expect = qq{[core]\n\tpenguin = little blüe\n};
+is( slurp($config_filename), $expect, 'Value with UTF-8' );
+
+$config->load;
+UTF8: {
+ use utf8;
+ is $config->get(key => 'core.penguin'), 'little blüe',
+ 'Get value with UTF-8';;
+}
+
+
+done_testing;
+
+sub slurp {
+ my $file = shift;
+ local ($/);
+ open( my $fh, $file ) or die "Unable to open file ${file}: $!";
+ return <$fh>;
+}
commit 90ef3ed1b9667eb3d9b897e408b0da777607317c
Author: Alex Vandiver <alexmv at bestpractical.com>
Date: Sat Aug 4 16:35:05 2012 -0400
Factor out slurp and burp into testing methods
diff --git a/t/comment.t b/t/comment.t
index ef8892c..399051a 100644
--- a/t/comment.t
+++ b/t/comment.t
@@ -22,7 +22,7 @@ $config->add_comment(
comment => 'yo dawg',
);
my $expect = "# yo dawg\n";
-is( slurp($config_filename), $expect, 'comment' );
+is( $config->slurp, $expect, 'comment' );
# Make sure leading whitespace is maintained.
$config->add_comment(
@@ -31,7 +31,7 @@ $config->add_comment(
);
$expect .= "# for you.\n";
-is( slurp($config_filename), $expect, 'comment with ws' );
+is( $config->slurp, $expect, 'comment with ws' );
# Make sure it interacts well with configuration.
$config->set(
@@ -57,7 +57,7 @@ $expect = <<'EOF'
# you know
EOF
;
-is( slurp($config_filename), $expect, 'indented comment with newlines and config' );
+is( $config->slurp, $expect, 'indented comment with newlines and config' );
$config->add_comment(
filename => $config_filename,
@@ -65,15 +65,6 @@ $config->add_comment(
semicolon => 1,
);
$expect .= "; gimme a semicolon\n";
-is( slurp($config_filename), $expect, 'comment with semicolon' );
+is( $config->slurp, $expect, 'comment with semicolon' );
done_testing;
-
-
-
-sub slurp {
- my $file = shift;
- local ($/);
- open( my $fh, $file ) or die "Unable to open file ${file}: $!";
- return <$fh>;
-}
diff --git a/t/encoding.t b/t/encoding.t
index c3b7b75..d857cac 100644
--- a/t/encoding.t
+++ b/t/encoding.t
@@ -29,21 +29,14 @@ UTF8: {
}
my $expect = qq{[core]\n\tpenguin = little blüe\n};
-is( slurp($config_filename), $expect, 'Value with UTF-8' );
+is( $config->slurp, $expect, 'Value with UTF-8' );
$config->load;
UTF8: {
use utf8;
is $config->get(key => 'core.penguin'), 'little blüe',
- 'Get value with UTF-8';;
+ 'Get value with UTF-8';
}
done_testing;
-
-sub slurp {
- my $file = shift;
- local ($/);
- open( my $fh, $file ) or die "Unable to open file ${file}: $!";
- return <$fh>;
-}
diff --git a/t/lib/TestConfig.pm b/t/lib/TestConfig.pm
index c47009c..0ab1721 100644
--- a/t/lib/TestConfig.pm
+++ b/t/lib/TestConfig.pm
@@ -38,6 +38,24 @@ sub global_file {
'etc', $self->confname );
}
+sub slurp {
+ my $self = shift;
+ my $file = shift || $self->dir_file;
+ local ($/);
+ open( my $fh, $file ) or die "Unable to open file $file: $!";
+ return <$fh>;
+}
+
+sub burp {
+ my $self = shift;
+ my $content = pop;
+ my $file_name = shift || $self->dir_file;
+
+ open( my $fh, ">", $file_name )
+ || die "can't open $file_name: $!";
+ print $fh $content;
+}
+
__PACKAGE__->meta->make_immutable;
no Any::Moose;
diff --git a/t/t1300-repo-config.t b/t/t1300-repo-config.t
index 7388983..5c01c77 100644
--- a/t/t1300-repo-config.t
+++ b/t/t1300-repo-config.t
@@ -15,22 +15,6 @@ use TestConfig;
# Additional tests that were not pulled from the git-config test-suite
# are also marked.
-sub slurp {
- my $file = shift;
- local ($/);
- open( my $fh, $file ) or die "Unable to open file ${file}: $!";
- return <$fh>;
-}
-
-sub burp {
- my ( $file_name, $content, $append ) = @_;
- my $mode = $append ? '>>' : '>';
-
- open( my $fh, $mode, $file_name )
- || die "can't open ${file_name}: $!";
- print $fh $content;
-}
-
# create an empty test directory in /tmp
my $config_dirname = tempdir( CLEANUP => !$ENV{CONFIG_GITLIKE_DEBUG} );
my $config_filename = File::Spec->catfile( $config_dirname, 'config' );
@@ -55,7 +39,7 @@ my $expect = <<'EOF'
EOF
;
-is( slurp($config_filename), $expect, 'initial' );
+is( $config->slurp, $expect, 'initial' );
$config->set(
key => 'Core.Movie',
@@ -70,7 +54,7 @@ $expect = <<'EOF'
EOF
;
-is( slurp($config_filename), $expect, 'mixed case' );
+is( $config->slurp, $expect, 'mixed case' );
$config->set(
key => 'Cores.WhatEver',
@@ -87,7 +71,7 @@ $expect = <<'EOF'
EOF
;
-is( slurp($config_filename), $expect, 'similar section' );
+is( $config->slurp, $expect, 'similar section' );
$config->set(
key => 'CORE.UPPERCASE',
@@ -105,7 +89,7 @@ $expect = <<'EOF'
EOF
;
-is( slurp($config_filename), $expect, 'similar section' );
+is( $config->slurp, $expect, 'similar section' );
# set returns nothing on success
lives_ok {
@@ -139,10 +123,9 @@ $expect = <<'EOF'
EOF
;
-is( slurp($config_filename), $expect, 'non-match result' );
+is( $config->slurp, $expect, 'non-match result' );
-burp(
- $config_filename,
+$config->burp(
'[alpha]
bar = foo
[beta]
@@ -161,10 +144,9 @@ bar = foo
EOF
;
-is( slurp($config_filename), $expect, 'unset with cont. lines is correct' );
+is( $config->slurp, $expect, 'unset with cont. lines is correct' );
-burp(
- $config_filename,
+$config->burp(
'[beta] ; silly comment # another comment
noIndent= sillyValue ; \'nother silly comment
@@ -196,7 +178,7 @@ noIndent= sillyValue ; 'nother silly comment
EOF
;
-is( slurp($config_filename), $expect, 'multiple unset is correct' );
+is( $config->slurp, $expect, 'multiple unset is correct' );
copy( $config2_filename, $config_filename )
or die "File cannot be copied: $!";
@@ -225,7 +207,7 @@ noIndent= sillyValue ; 'nother silly comment
EOF
;
-is( slurp($config_filename), $expect, 'all replaced' );
+is( $config->slurp, $expect, 'all replaced' );
$config->set(
key => 'beta.haha',
@@ -244,7 +226,7 @@ noIndent= sillyValue ; 'nother silly comment
EOF
;
-is( slurp($config_filename), $expect, 'really mean test' );
+is( $config->slurp, $expect, 'really mean test' );
$config->set(
key => 'nextsection.nonewline',
@@ -267,7 +249,7 @@ noIndent= sillyValue ; 'nother silly comment
EOF
;
-is( slurp($config_filename), $expect, 'really really mean test' );
+is( $config->slurp, $expect, 'really really mean test' );
$config->load;
is( $config->get( key => 'beta.haha' ), 'alpha', 'get value' );
@@ -285,7 +267,7 @@ noIndent= sillyValue ; 'nother silly comment
EOF
;
-is( slurp($config_filename), $expect, 'unset' );
+is( $config->slurp, $expect, 'unset' );
$config->set(
key => 'nextsection.NoNewLine',
@@ -305,7 +287,7 @@ noIndent= sillyValue ; 'nother silly comment
EOF
;
-is( slurp($config_filename), $expect, 'multivar' );
+is( $config->slurp, $expect, 'multivar' );
$config->load;
lives_ok {
@@ -353,7 +335,7 @@ noIndent= sillyValue ; 'nother silly comment
NoNewLine = wow2 for me
EOF
;
-is( slurp($config_filename), $expect, 'multivar replace only the first match' );
+is( $config->slurp, $expect, 'multivar replace only the first match' );
$config->load;
throws_ok {
@@ -393,7 +375,7 @@ noIndent= sillyValue ; 'nother silly comment
EOF
;
-is( slurp($config_filename), $expect, 'multivar unset' );
+is( $config->slurp, $expect, 'multivar unset' );
# ADDITIONAL TESTS (7): our rules for valid keys are
# much more permissive than git's
@@ -488,7 +470,7 @@ noIndent= sillyValue ; 'nother silly comment
EOF
;
-is( slurp($config_filename), $expect, 'hierarchical section value' );
+is( $config->slurp, $expect, 'hierarchical section value' );
$expect = <<'EOF'
123456.a123=987
@@ -537,8 +519,7 @@ $config->load;
is_deeply( scalar $config->get_all( key => 'nextsection.nonewline' ),
$expect, '--add' );
-burp(
- $config_filename,
+$config->burp(
'[novalue]
variable
[emptyvalue]
@@ -580,8 +561,7 @@ ok( !$config->get( key => 'emptyvalue.variable', as => 'bool' ),
'get bool variable with empty value' );
# testing alternate subsection notation
-burp(
- $config_filename,
+$config->burp(
'[a.b]
c = d
'
@@ -597,7 +577,7 @@ $expect = <<'EOF'
EOF
;
-is( slurp($config_filename), $expect,
+is( $config->slurp, $expect,
'new section is partial match of another' );
$config->set( key => 'b.x', value => 'y', filename => $config_filename );
@@ -615,7 +595,7 @@ $expect = <<'EOF'
EOF
;
-is( slurp($config_filename), $expect,
+is( $config->slurp, $expect,
'new variable inserts into proper section' );
# testing rename_section
@@ -623,8 +603,7 @@ is( slurp($config_filename), $expect,
# NOTE: added comment after [branch "1 234 blabl/a"] to check that our
# implementation doesn't blow away trailing text after a rename like
# git-config currently does
-burp(
- $config_filename,
+$config->burp(
'# Hallo
#Bello
[branch "eins"]
@@ -657,7 +636,7 @@ weird
EOF
;
-is( slurp($config_filename), $expect, 'rename succeeded' );
+is( $config->slurp, $expect, 'rename succeeded' );
throws_ok {
$config->rename_section(
@@ -668,7 +647,7 @@ throws_ok {
}
qr/no such section/i, 'rename non-existing section';
-is( slurp($config_filename), $expect,
+is( $config->slurp, $expect,
'rename non-existing section changes nothing' );
lives_ok {
@@ -695,16 +674,15 @@ weird
EOF
;
-is( slurp($config_filename), $expect, 'rename succeeded' );
+is( $config->slurp, $expect, 'rename succeeded' );
# [branch "vier"] doesn't get interpreted as a real section
# header because the variable definition before it means
# that all the way to the end of that line is a part of
# a's value
-burp(
- $config_filename,
- '[branch "zwei"] a = 1 [branch "vier"]
-', 1
+$config->burp(
+ $config->slurp . '[branch "zwei"] a = 1 [branch "vier"]
+'
);
lives_ok {
@@ -726,7 +704,7 @@ weird
EOF
;
-is( slurp($config_filename), $expect, 'section was removed properly' );
+is( $config->slurp, $expect, 'section was removed properly' );
unlink $config_filename;
@@ -754,7 +732,7 @@ $config->set(
value => '%Ggitcvs2.%a.%m.sqlite',
filename => $config_filename
);
-is( slurp($config_filename), $expect, 'section ending' );
+is( $config->slurp, $expect, 'section ending' );
# testing int casting
@@ -897,12 +875,11 @@ $config->set(
as => 'int'
);
-is( slurp($config_filename), $expect, 'set --int' );
+is( $config->slurp, $expect, 'set --int' );
unlink $config_filename;
-burp(
- $config_filename,
+$config->burp(
'[bool]
true1 = on
true2 = yes
@@ -989,7 +966,7 @@ $config->set(
filename => $config_filename
);
-is( slurp($config_filename), $expect, 'set bool-or-int' );
+is( $config->slurp, $expect, 'set bool-or-int' );
unlink $config_filename;
@@ -1023,7 +1000,7 @@ $expect = <<'EOF'
EOF
;
-is( slurp($config_filename), $expect, 'quoting' );
+is( $config->slurp, $expect, 'quoting' );
throws_ok {
$config->set(
@@ -1043,8 +1020,7 @@ lives_ok {
}
'value with newline';
-burp(
- $config_filename,
+$config->burp(
'[section]
; comment \
continued = cont\
@@ -1102,8 +1078,7 @@ SKIP: {
### see tests for and think should be tested)
# weird yet valid edge case
-burp(
- $config_filename,
+$config->burp(
'# foo
[section] [section2] a = 1
b = 2
@@ -1120,8 +1095,7 @@ EOF
is( $config->dump, $expect, 'section headers are valid w/out newline' );
-burp(
- $config_filename,
+$config->burp(
'# foo
[section]
b = off
@@ -1197,14 +1171,14 @@ my $repo_config = $config_filename;
mkdir File::Spec->catdir( $config_dirname, 'etc' );
mkdir File::Spec->catdir( $config_dirname, 'home' );
-burp(
+$config->burp(
$repo_config,
'[section]
b = off
'
);
-burp(
+$config->burp(
$user_config,
'[section]
b = on
@@ -1219,7 +1193,7 @@ is( $config->get( key => 'section.b' ), 'off',
is( $config->get( key => 'section.a' ), 'off',
'user config is loaded');
-burp(
+$config->burp(
$global_config,
'[section]
b = true
@@ -1270,8 +1244,7 @@ unlink $user_config;
unlink $repo_config;
# Test to make sure subsection comparison is case-sensitive.
-burp(
- $config_filename,
+$config->burp(
'[section "FOO"]
b = true
[section "foo"]
@@ -1288,8 +1261,7 @@ is( $config->get( key => 'section.FOO.b' ), 'true',
# Test section names with with weird characters in them (non git-compat)
-burp(
- $config_filename,
+$config->burp(
'[http://www.example.com/test/]
admin = foo at bar.com
[http://www.example.com/test/ "users"]
@@ -1323,8 +1295,7 @@ $config->compatible(1);
# variables names that start with numbers or contain characters other
# than a-zA-Z- are illegal
-burp(
- $config_filename,
+$config->burp(
'[section "FOO"]
foo..bar = true
'
@@ -1333,8 +1304,7 @@ burp(
throws_ok { $config->load; } qr/error parsing/im,
'variable names cannot contain . in git-compat mode';
-burp(
- $config_filename,
+$config->burp(
'[section "FOO"]
foo%@$#bar = true
'
@@ -1343,8 +1313,7 @@ burp(
throws_ok { $config->load; } qr/error parsing/im,
'variable names cannot contain symbols in git-compat mode';
-burp(
- $config_filename,
+$config->burp(
'[section "FOO"]
01inval = true
'
@@ -1353,8 +1322,7 @@ burp(
throws_ok { $config->load; } qr/error parsing/im,
'variable names cannot start with a number git-compat mode';
-burp(
- $config_filename,
+$config->burp(
'[section "FOO"]
-inval = true
'
@@ -1394,8 +1362,7 @@ throws_ok {
# section names cannot contain characters other than a-zA-Z-. in compat mode
-burp(
- $config_filename,
+$config->burp(
'[se$^%#& "FOO"]
a = b
'
@@ -1404,8 +1371,7 @@ burp(
throws_ok { $config->load; } qr/error parsing/im,
'section names cannot contain symbols in git-compat mode';
-burp(
- $config_filename,
+$config->burp(
'[sec tion "FOO"]
a = b
'
@@ -1414,8 +1380,7 @@ burp(
throws_ok { $config->load; } qr/error parsing/im,
'section names cannot contain whitespace in git-compat mode';
-burp(
- $config_filename,
+$config->burp(
'[-foo.bar-baz "FOO"]
a = b
'
@@ -1470,8 +1435,7 @@ throws_ok {
'subsection names cannot contain unescaped newlines in nocompat mode';
# Make sure some bad configs throw errors.
-burp(
- $config_filename,
+$config->burp(
'[testing "FOO"
a = b
'
@@ -1482,8 +1446,7 @@ $config->compatible(1);
throws_ok { $config->load } qr/error parsing/i, 'invalid section (compat)';
# This should be OK since the variable name doesn't start with [
-burp(
- $config_filename,
+$config->burp(
'[test]
a[] = b
'
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list