Config-Properties-1.80/0000755000175000017500000000000012525102212013767 5ustar salvasalvaConfig-Properties-1.80/Changes0000644000175000017500000001614412525102124015272 0ustar salvasalvaRevision history for Perl extension Config::Properties. 1.80 May 14, 2015 - add be_like_java feature (bug report by Bojan Jovanovic) - generate warnings only when enabled 1.79 May 7, 2015 - add repository metadata 1.78 May 7, 2015 - accept any end of line terminator (i.e. "\r\n", "\r" or "\n") independently of the underlaying operating system (bug report by William Fishburne, problem analysis by Alexander Brett) 1.77 Apr 27, 2014 - binmode doesn't work on IO::String and others tied objects (bug report by Mithun Ayachit) - fix spelling errors 1.76 Feb 13, 2014 - add encoding feature 1.75 Jul 16, 2012 - add support for order feature - silence warning on saveToString method (bug report by Mithun Ayachit) 1.73 Oct 4, 2011 - allow disabling wrapping 1.72 Jul 13, 2011 - reorganize package structure - improve documentation - accept a filename on the constructor and load it - accept optional arguments on the constructor - accept a hash as defaults 1.71 May 31, 2009 - changeProperties was generating a warning when the former value was undef (bug report by Jony Salonen) 1.70 Apr 22, 2009 - Solve bug in testing file 6_sorted.t (bug report and patch by Ian Malpass) 1.69 Dec 1, 2008 - Delete temporal files created on tests (bug report by Andreas Koenig) 1.68 Oct 27, 2007 - the regular expresion used to detect unicode BOM was not correct - work around unicode bug in perl 5.6.0 - require perl 5.6.0 in Makefile.PL - test pods 1.67 Aug 20, 2007 - splitToTree was not handling defaults properly (bug report and patch submitted by Filip Chodounsky) 1.66 Sep 8 2006 - this module is very stable now, use 1.x version numbers to reflect it. 0.65 Sep 8 2006 - add setFromTree and changeFromTree methods as requested by Nito. 0.64 Jul 26 2006 - add support for start parameter to splitToTree method. 0.63 Mar 30 2006 - silly bug on test file removed 0.62 Mar 29 2006 - add support for saveToString and splitToTree methods (suggested by Clayton Scott). 0.61 Jul 27 2005 - the regular expression used to remove utf8 byte order marks was failing on 5.6.x due to a perl bug (reported by Dominik Stadler). 0.60 Jun 27 2005 - handle utf8 BOM (bug reported by Trent Wood). - doc typos corrected 0.59 Apr 14 2005 - remove old unused deprecated features PERL_MODE and object creation from prototype. - remove undocumented redundant list function. - remove deprecated perlMode and setPerlMode functions. - change validator processing, to allow for key redefinition. - remembers key line numbers for expressive duplicate error reports. - empty properties before loading new file. - improve docs. - license notice added to the docs. 0.58 Sep 16 2004 - on getProperty methods admit several defaults and take the first defined one. - new requireProperty method 0.57 May 07 2004 - retain properties read/construction order when saving 0.56 Oct 20 2003 - corrected \uXXXX unescaping (Guntis) 0.55 Sep 22 2003 - corrected bug in getProperties returning a flatten hash instead of a reference to it. 0.54 Sep 19 2003 - public methods documented - new method changeProperty - new method deleteProperty - propertyNames now also returns names from default properties - getProperties now also returns default properties - new properties method returning a flatten hash with all the properties added - setProperty doesn't return the old value anymore... anyway it's implementation was always broken! - parameter checking changed to use some common functions 0.53 Aug 15 2003 - fall back mode and warning when Text::Wrap module is not recent enough. 0.52 Jul 30 2003 - added new test for saving and wrapping 0.51 Jun 10 2003 - improved docs for beginners - pointer to Config::Properties::Simple added 0.50 May 27 2003 - escape $_ on test name on 1_parse.t - require latest Text::Wrap version 0.49 May 20 2003 - CRLF line ends from windows files were not correctly handled on unix - test for that bug 0.48 May 1 2003 - added new test for parsing \\ 0.47 Apr 26 2003 - more tests added - escape '#' and '!' at key starts / unescape - process_line method signature changed - don't use $_ because it can be read only bug (Craig Manley) 0.46 Apr 24 2003 - 5_test.t was printing debug information 0.45 Apr 24 2003 - more tests added - wrapping of several consecutive spaces works now - spaces at the beginning and at the end of keywords and values escaped when saving - added wrapping when saving long properties 0.44 Apr 23 2003 - process_line deep recursion problem fixed (Eric Kolve) - getProperties now return a copy and not a ref to the properties hash inside the object - new from object deprecated - unused PERL_MODE deprecated - general code cleanup - code reformated to 4 space indents 0.43 Tue Apr 15 2003 - module maintenace changed from Craig Manley to Salvador Fandiño 0.42 Tue Apr 15 2003 - Added 'setValidator', 'getValidator' and 'validator' methods - Added 'validate' method to perform validations on property/value pairs - Added 'fail' method to report errors - Added 'line_number' method - Use Carp to report interface errors - Reworked unescape to handle unicode sequences - Reworked parsing regexp to support escaping [:= ] on property names - Escape conflicting chars when writing - Tests changed to use to Test::More - Added some tests 0.41 Tue Jul 10 00:00:00 2002 - Fixed value checks in most methods that incorrectly treated the value '0' or the empty string as an undefined value. I could not contact the original author in any way (tried 3 email addresses and news://comp.lang.perl.modules), so I uploaded this version myself. Craig Manley (c.manley at skybound.nl). 0.40 Tue Jul 10 11:32:00 2001 - 0.4 (almost half-way there) release - Add format/getFormat/setFormat() to change the appearance of saved properties (thanks to David Boyce for the idea) - Added POD documenation for format feature - Typo fixes in POD - Add reference to official JavaDoc (idea thanks to David Boyce) Randy Jay Yarger (ryarger@mediaone.net) - Fixed default handling when retrieving a property value David Boyce (dsb@world.std.com) 0.03 Sat May 19 21:56:10 2001 - Corrected Object Oriented behavior (was using class variables for everying, now using instance variables) - Skip blank lines (spotted by Eric Zylberstejn and Christian Niles) - Fixed borked packaging (#$@% Windows!) (spotted by Ken Ho, Michael Peterson and David Boyce) - Fixed incorrect version number (spotted by Michael Peterson and David Boyce) Randy Jay Yarger (ryarger@mediaone.net) - Allow the escape characters proscribed by the Java API spec Christian Niles (can207@nyu.edu) 0.02 Thu May 03 21:19:00 2001 - Fixed bug relating to doubled escape characters(\\). Thanks to David Boyce for the spot. Randy Jay Yarger (ryarger@mediaone.net) 0.01 Wed Jan 17 15:38:07 2001 - original version; created by h2xs 1.20 with options -X -n Config::Properties Randy Jay Yarger (ryarger@mediaone.net) Config-Properties-1.80/t/0000755000175000017500000000000012525102212014232 5ustar salvasalvaConfig-Properties-1.80/t/6_sorted.t0000644000175000017500000000223512000746535016160 0ustar salvasalvause Test::More tests => 8; use Config::Properties; use File::Temp qw(tempfile); my $cfg=Config::Properties->new(); $cfg->load(\*DATA); my ($fh, $fn)=tempfile() or die "unable to create temporal file to save properties"; $cfg->deleteProperty('dos'); $cfg->setProperty('cinco', '5'); $cfg->setProperty('tres', '6!'); $cfg->store($fh, "test header"); ok(close($fh), "config write"); open CFG, '<', $fn or die "unable to open tempory file $fn"; undef $/; $contents=; ok(close(CFG), "config read"); # print STDERR "$fn\n$contents\n"; ok($contents=~/uno.*tres.*cuatro.*cinco/s, "order preserved"); unlink $fn; ok((not -e $fn), "delete test file"); ($fh, $fn)=tempfile() or die "unable to create temporal file to save properties"; $cfg->order('alpha'); $cfg->store($fh, "test header"); ok(close($fh), "config write"); open CFG, '<', $fn or die "unable to open tempory file $fn"; undef $/; $contents=; ok(close(CFG), "config read"); # print STDERR "$fn\n$contents\n"; ok($contents=~/cinco.*cuatro.*tres.*uno/s, "alpha order preserved"); unlink $fn; ok((not -e $fn), "delete test file"); __DATA__ uno = 1u dos = 2u tres = 3u cuatro = 4u Config-Properties-1.80/t/3_valid.t0000644000175000017500000000117111400711211015734 0ustar salvasalva# -*- Mode: Perl -*- # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 1.t' use Test::More tests => 1; use Config::Properties; my $cfg=Config::Properties->new(); my %valid = map { $_=> 1 } qw ( foo Bar eq=ua:l more less cra\n=:\ \\z'y' ); $cfg->setValidator( sub { $valid{shift()} } ); eval { $cfg->load(\*DATA); }; is ($cfg->getProperty('foo'),'one', 'foo'); __DATA__ # hello foo=one Bar : maybe one\none\tone\r eq\=ua\:l jamon more : another \ configuration \ line less= who said:\tless ??? cra\n\=\:\ \\z'y' jump Config-Properties-1.80/t/2_error.t0000644000175000017500000000101611400711211015763 0ustar salvasalva# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 1.t' use Test::More tests => 2; BEGIN { use_ok('Config::Properties') }; my $cfg=Config::Properties->new(); eval { $cfg->load(\*DATA) }; like ($@, qr/line\s6\b/, "error at line 6 is ok"); __DATA__ # hello foo=one Bar : maybe one\none\tone\r eq\=ua\:l jamon this_is_an_error\=line more : another \ configuration \ line less= who said:\tless ??? cra\n\=\:\ \\z'y' jump Config-Properties-1.80/t/4_invalid.t0000644000175000017500000000117711400711211016272 0ustar salvasalva# -*- Mode: Perl -*- # Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 1.t' use Test::More tests => 1; use Config::Properties; my $cfg=Config::Properties->new(); my %valid = map { $_=> 1 } qw ( foo Bar eq=ua:l more cra\n=:\ \\z'y' ); $cfg->setValidator( sub { $valid{shift()} } ); eval { $cfg->load(\*DATA); }; like ($@, qr/less.*line 9\b/, 'invalid line 9 is ok'); __DATA__ # hello foo=one Bar : maybe one\none\tone\r eq\=ua\:l jamon more : another \ configuration \ line less= who said:\tless ??? cra\n\=\:\ \\z'y' jump Config-Properties-1.80/t/utf8.t0000644000175000017500000000036012277156215015324 0ustar salvasalva# -*- Mode: Perl -*- use Test::More tests => 1; use Config::Properties; my $cfg = Config::Properties->new(encoding => 'UTF-8'); $cfg->load(\*DATA); is ($cfg->getProperty('country'), "Espa\xf1a", 'country'); __DATA__ country = España Config-Properties-1.80/t/5_save.t0000644000175000017500000000443512522612123015613 0ustar salvasalva# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 1.t' use Test::More tests => 26; use Config::Properties; use File::Temp qw(tempfile); my $cfg=Config::Properties->new(); $cfg->load(\*DATA); my ($fh, $fn)=tempfile() or die "unable to create temporal file to save properties"; # print STDERR "saving properties to '$fn'\n"; $cfg->store($fh, "test header"); close ($fh) or die "unable to close temporal file with properties saved"; open(R, '<', $fn) or die "unable to open temporal file with properties saved"; my $cfg2=Config::Properties->new(); $cfg2->load(\*R); close R or die "unable to read temporal file with properties saved"; # use Assert::Quote ':short'; foreach my $k ($cfg->propertyNames, $cfg2->propertyNames) { is ($cfg->getProperty($k), $cfg2->getProperty($k), "same key/value") # $cfg->getProperty($k) eq $cfg2->getProperty($k) # or D($cfg->getProperty($k), $cfg2->getProperty($k)) # or print STDERR S($k), "\n1:", A, "\n2:", B, "\n\n"; } unlink $fn; __DATA__ # hello foo=one Bar : maybe one\none\tone\r eq\=ua\:l jamon\njamon\njamon\nmas\tjamon \ spaces\ = \ at the begining and at the end \ in the key and in the\nvalue more : another \ configuration \ line less= who said:\tless ??? cra\n\=\:\ \\z'y' jump long\ line = Text::Wrap::wrap()" has a number of variables that control its behav- \ ior. Because other modules might be using "Text::Wrap::wrap()" it is \ suggested that you leave these variables alone! If you can't do that, \ then use "local($Text::Wrap::VARIABLE) = YOURVALUE" when you change the \ values so that the original value is restored. This "local()" trick \ will not work if you import the variable into your own namespace. wrap-me: \ \ \ \ \ \ \ \\ \\\\\ \\ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ \ hello! cmd3=/usr/share/Artemis/bin/loki -vip 10.51.100.120 -file f3058 -it 10 -repeat 100000000 -proc read -vdir /vol1 -useGateway 172.16.254.254 %ETH% too\ many\ spaces:\ hello again! # comment = hello \# comment = bye ! comment2 = good \! comment2 = bye Config-Properties-1.80/t/1_parse.t0000644000175000017500000000357011400711211015752 0ustar salvasalva# Before `make install' is performed this script should be runnable with # `make test'. After `make install' it should work as `perl 1.t' use utf8; use Test::More tests => 17; BEGIN { use_ok('Config::Properties') }; my $cfg=Config::Properties->new(); for (1) { eval { $cfg->load(\*DATA) }; } ok (!$@, "don't use \$_"); is ($cfg->getProperty('foo'), 'one', 'foo'); is ($cfg->getProperty('eq=ua:l'), 'jamon', 'eq=ual'); is ($cfg->getProperty('Bar'), "maybe one\none\tone\r", 'Bar'); is ($cfg->getProperty('more'), 'another configuration line', 'more'); is ($cfg->getProperty('less'), "who said:\tless ??? ", 'less'); is ($cfg->getProperty("cra\n=: \\z'y'"), 'jump', 'crazy'); is ($cfg->getProperty("#nocmt"), 'good', 'no comment 1'); is ($cfg->getProperty("!nocmt"), 'good', 'no comment 2'); is ($cfg->getProperty("lineend1"), 'here', 'line end 1'); is ($cfg->getProperty("lineend2"), 'here', 'line end 2'); is ($cfg->getProperty("\\\\machinename\\folder"), "\\\\windows\\ style\\path", 'windows style path'); is ($cfg->getProperty("cmd3"), '/usr/share/Artemis/bin/loki -vip 10.51.100.120 -file f3058 -it 10 -repeat 100000000 -proc read -vdir /vol1 -useGateway 172.16.254.254 %ETH%', 'derrick bug'); is ($cfg->getProperty("unicode"), "he\x{0113}llo", "unicode unencode"); is ($cfg->getProperties->{foo}, 'one', 'getProperties one'); my %props=$cfg->properties; is ($props{foo}, 'one', 'properties one'); __DATA__ # hello foo=one Bar : maybe one\none\tone\r eq\=ua\:l jamon more : another \ configuration \ line less= who said:\tless ??? cra\n\=\:\ \\z'y' jump \#nocmt = good #nocmt = bad \!nocmt = good !nocmt = bad unicode = he\u0113llo lineend1=here lineend2=here cmd3=/usr/share/Artemis/bin/loki -vip 10.51.100.120 -file f3058 -it 10 -repeat 100000000 -proc read -vdir /vol1 -useGateway 172.16.254.254 %ETH% \\\\machinename\\folder = \\\\windows\\ style\\path Config-Properties-1.80/lib/0000755000175000017500000000000012525102212014535 5ustar salvasalvaConfig-Properties-1.80/lib/Config/0000755000175000017500000000000012525102212015742 5ustar salvasalvaConfig-Properties-1.80/lib/Config/Properties.pm0000644000175000017500000005750612525102141020452 0ustar salvasalvapackage Config::Properties; use strict; use warnings; our $VERSION = '1.80'; use IO::Handle; use Carp; use PerlIO qw(); use Errno qw(); { no warnings; sub _t_key ($) { my $k=shift; defined($k) && length($k) or croak "invalid property key '$k'"; } sub _t_value ($) { my $v=shift; defined $v or croak "undef is not a valid value for a property"; } sub _t_format ($) { my $f=shift; defined ($f) && $f=~/\%s.*\%s/ or croak "invalid format '%f'"; } sub _t_validator ($) { my $v=shift; defined($v) && UNIVERSAL::isa($v, 'CODE') or croak "invalid property validator '$v'"; } sub _t_file ($) { my $f=shift; defined ($f) or croak "invalid file '$f'"; } sub _t_order ($) { my $o = shift; $o =~ /^(?:keep|alpha|none)$/ or croak "invalid order"; } sub _t_encoding ($) { my $e = shift; $e =~ /^[\w\-]+$/ or croak "invalid encoding '$e'"; } } # new() - Constructor # # The constructor can take one optional argument "$defaultProperties" # which is an instance of Config::Properties to be used as defaults # for this object. sub new { my $class = shift; my $defaults; $defaults = shift if @_ & 1; my %opts = @_; $defaults = delete $opts{defaults} unless defined $defaults; my $be_like_java = delete $opts{be_like_java}; my $format = delete $opts{format}; $format = '%s=%s' unless defined $format; my $wrap = delete $opts{wrap}; $wrap = !$be_like_java unless defined $wrap; my $order = delete $opts{order}; $order = 'keep' unless defined $order; _t_order($order); my $file = delete $opts{file}; my $encoding = delete $opts{encoding}; $encoding = 'latin1' unless defined $encoding; _t_encoding($encoding); my $eol_re = delete $opts{eol_re}; $eol_re = qr/\r\n|\n|\r/ unless defined $eol_re; my $line_re = qr/^(.*?)(?:$eol_re)/s; %opts and croak "invalid option(s) '" . join("', '", keys %opts) . "'"; if (defined $defaults) { if (ref $defaults eq 'HASH') { my $d = Config::Properties->new; while (my ($k, $v) = each %$defaults) { $d->setProperty($k, $v); } $defaults = $d; } elsif (!$defaults->isa('Config::Properties')) { croak die "defaults parameter is not a Config::Properties object or a hash" } } my $self = { defaults => $defaults, be_like_java => $be_like_java, format => $format, wrap => $wrap, order => $order, properties => {}, last_line_number => 0, property_line_numbers => {}, file => $file, encoding => $encoding, line_re => $line_re }; bless $self, $class; if (defined $file) { open my $fh, '<', $file or croak "unable to open file '$file': $!"; $self->load($fh); close $fh or croak "unable to load file '$file': $!"; } return $self; } # set property only if its going to change the property value. # sub changeProperty { my ($self, $key, $new, @defaults) = @_; _t_key $key; _t_value $new; my $old=$self->getProperty($key, @defaults); if (!defined $old or $old ne $new) { $self->setProperty($key, $new); return 1; } return 0; } sub deleteProperty { my ($self, $key, $recurse) = @_; _t_key $key; if (exists $self->{properties}{$key}) { delete $self->{properties}{$key}; delete $self->{property_line_numbers}{$key}; } $self->{defaults}->deleteProperty($key, 1) if ($recurse and $self->{defaults}); } # setProperty() - Set the value for a specific property sub setProperty { my ($self, $key, $value)=@_; _t_key $key; _t_value $value; defined(wantarray) and warnings::warnif(void => "warning: setProperty doesn't return the old value anymore"); $self->{property_line_numbers}{$key} ||= ++$self->{last_line_number}; $self->{properties}{$key} = $value; } sub _properties { my $self=shift; if (defined ($self->{defaults})) { my %p=($self->{defaults}->_properties, %{$self->{properties}}); return %p; } return %{ $self->{properties} } } # properties() - return a flated hash with all the properties sub properties { my $self = shift; my %p = $self->_properties; map { $_ => $p{$_} } $self->_sort_keys(keys %p); } # getProperties() - Return a hashref of all of the properties sub getProperties { return { shift->_properties }; } # getFormat() - Return the output format for the properties sub getFormat { shift->{format} } # setFormat() - Set the output format for the properties sub setFormat { my ($self, $format) = @_; defined $format or $format='%s=%s'; _t_format $format; $self->{format} = $format; } # format() - Alias for get/setFormat(); sub format { my $self = shift; if (@_) { return $self->setFormat(@_) } $self->getFormat(); } # setValidator(\&validator) - Set sub to be called to validate # property/value pairs. It is called # &validator($property, $value, $config) being $config # the Config::Properties object. $property and $key # can be modified by the validator via $_[0] and $_[1] sub setValidator { my ($self, $validator) = @_; _t_validator $validator; $self->{validator} = $validator; } # getValidator() - Return the current validator sub sub getValidator { shift->{validator} } # validator() - Alias for get/setValidator(); sub validator { my $self=shift; if (@_) { return $self->setValidator(@_) } $self->getValidator } sub setOrder { my ($self, $order) = @_; _t_order $order; $self->{order} = $order } sub getOrder { shift->{order} } sub order { my $self = shift; $self->setOrder(@_) if @_; $self->{order}; } # load() - Load the properties from a filehandle sub load { my ($self, $file) = @_; _t_file $file; # check whether it is a real file handle my $fn = do { local $@; eval { fileno($file) } }; if (defined $fn and $fn >0) { unless (grep /^(?:encoding|utf8)\b/, PerlIO::get_layers($file)) { binmode $file, ":encoding($self->{encoding})" or croak "Unable to set file encoding layer: $!"; } } $self->{properties} = {}; $self->{property_line_numbers} = {}; my $ln = $file->input_line_number; $self->{last_line_number} = ($ln > 0 ? $ln : 0); $self->{buffer_in} = ''; 1 while $self->process_line($file); $self->{last_line_number}; } # escape_key(string), escape_value(string), unescape(string) - # subroutines to convert escaped characters to their # real counterparts back and forward. my %esc = ( "\n" => 'n', "\r" => 'r', "\t" => 't' ); my %unesc = reverse %esc; sub escape_key { $_[0]=~s{([\t\n\r\\"' =:])}{ "\\".($esc{$1}||$1) }ge; $_[0]=~s{([^\x20-\x7e])}{sprintf "\\u%04x", ord $1}ge; $_[0]=~s/^ /\\ /; $_[0]=~s/^([#!])/\\$1/; $_[0]=~s/(?{buffer_in}; my $line_re = $self->{line_re}; while (1) { if ($$bin =~ s/$line_re//) { $self->{last_line_number}++; return $1; } else { my $bytes = read($file, $$bin, 8192, length $$bin); last unless $bytes or (not defined $bytes and ($! == Errno::EGAIN() or $! == Errno::EWOULDBLOCK() or $! == Errno::EINTR())); } } if (length $$bin) { $self->{last_line_number}++; my $line = $$bin; $$bin = ''; return $line } undef; } # process_line() - read and parse a line from the properties file. # this is to workaround a bug in perl 5.6.0 related to unicode my $bomre = eval(q< qr/^\\x{FEFF}/ >) || qr//; sub process_line { my ($self, $file) = @_; my $line = $self->read_line($file); defined $line or return undef; # remove utf8 byte order mark my $ln = $self->{last_line_number}; $line =~ s/$bomre// if $ln < 2; # ignore comments $line =~ /^\s*(\#|\!|$)/ and return 1; # handle continuation lines my @lines; while ($line =~ /(\\+)$/ and length($1) & 1) { $line =~ s/\\$//; push @lines, $line; $line = $self->read_line($file); $line = '' unless defined $line; $line =~ s/^\s+//; } $line = join('', @lines, $line) if @lines; my ($key, $value) = $line =~ /^ \s* ((?:[^\s:=\\]|\\.)+) \s* [:=\s] \s* (.*) $ /x or $self->fail("invalid property line '$line'"); unescape $key; unescape $value; $self->validate($key, $value); $self->{property_line_numbers}{$key} = $ln; $self->{properties}{$key} = $value; return 1; } sub validate { my $self=shift; my $validator = $self->{validator}; if (defined $validator) { &{$validator}(@_, $self) or $self->fail("invalid value '$_[1]' for '$_[0]'"); } } # line_number() - number for the last line read from the configuration file sub line_number { shift->{last_line_number} } # fail(error) - report errors in the configuration file while reading. sub fail { my ($self, $error) = @_; die "$error at line ".$self->line_number()."\n"; } sub _sort_keys { my $self = shift; my $order = $self->{order}; if ($order eq 'keep') { my $sk = $self->{property_line_numbers}; no warnings 'uninitialized'; return sort { $sk->{$a} <=> $sk->{$b} } @_; } if ($order eq 'alpha') { return sort @_; } return @_; } # _save() - Utility function that performs the actual saving of # the properties file to a filehandle. sub _save { my ($self, $file) = @_; _t_file $file; my $wrap; if ($self->{wrap}) { eval { no warnings; require Text::Wrap; $wrap=($Text::Wrap::VERSION >= 2001.0929); }; unless ($wrap) { warnings::warn("Text::Wrap module is to old, version 2001.0929 or newer required: long lines will not be wrapped"); } } local($Text::Wrap::separator)=" \\\n" if $wrap; local($Text::Wrap::unexpand)=undef if $wrap; local($Text::Wrap::huge)='overflow' if $wrap; local($Text::Wrap::break)=qr/(?_sort_keys(keys %{$self->{properties}})) { my $key=$_; my $value=$self->{properties}{$key}; escape_key $key; if ($self->{be_like_java}) { escape_key $value; } else { escape_value $value; } if ($wrap) { $file->print( Text::Wrap::wrap( "", " ", sprintf( $self->{'format'}, $key, $value ) ), "\n" ); } else { $file->print(sprintf( $self->{'format'}, $key, $value ), "\n") } } } # save() - Save the properties to a filehandle with the given header. sub save { my ($self, $file, $header) = @_; _t_file($file); if (defined $header) { $header=~s/\n/# \n/sg; print $file "# $header\n#\n"; } print $file '# ' . localtime() . "\n\n"; $self->_save( $file ); } sub saveToString { my $self = shift; my $str = ''; open my $fh, '>', \$str or die "unable to open string ref as file"; $self->save($fh, @_); close $fh or die "unable to write to in memory file"; return $str; } sub _split_to_tree { my ($self, $tree, $re, $start) = @_; if (defined $self->{defaults}) { $self->{defaults}->_split_to_tree($tree, $re, $start); } for my $key (keys %{$self->{properties}}) { my $ekey = $key; if (defined $start) { $ekey =~ s/$start// or next; } my @parts = split $re, $ekey; @parts = '' unless @parts; my $t = $tree; while (@parts) { my $part = shift @parts; my $old = $t->{$part}; if (@parts) { if (defined $old) { if (ref $old) { $t = $old; } else { $t = $t->{$part} = { '' => $old }; } } else { $t = $t->{$part} = {}; } } else { my $value = $self->{properties}{$key}; if (ref $old) { $old->{''} = $value; } else { $t->{$part} = $value; } } } } } sub splitToTree { my ($self, $re, $start) = @_; $re = qr/\./ unless defined $re; $re = qr/$re/ unless ref $re; if (defined $start) { $start = quotemeta $start; $start = qr/^$start$re/ } my $tree = {}; $self->_split_to_tree($tree, $re, $start); $tree; } sub _unsplit_from_tree { my ($self, $method, $tree, $sep, @start) = @_; $sep = '.' unless defined $sep; my $ref = ref $tree; if ($ref eq 'HASH') { for my $key (keys %$tree) { $self->_unsplit_from_tree($method, $tree->{$key}, $sep, @start, ($key ne '' ? $key : ())) } } elsif ($ref eq 'ARRAY') { for my $key (0..$#$tree) { $self->_unsplit_from_tree($method, $tree->[$key], $sep, @start, $key) } } elsif ($ref) { croak "unexpected object '$ref' found inside tree" } else { $self->$method(join($sep, @start), $tree) } } sub setFromTree { shift->_unsplit_from_tree(setProperty => @_) } sub changeFromTree { shift->_unsplit_from_tree(changeProperty => @_) } # store() - Synonym for save() *store = \&save; # getProperty() - Return the value of a property key. Returns the default # for that key (if there is one) if no value exists for that key. sub getProperty { my $self = shift; my $key = shift; _t_key $key; if (exists $self->{properties}{$key}) { return $self->{properties}{$key} } elsif (defined $self->{defaults}) { return $self->{defaults}->getProperty($key, @_); } for (@_) { return $_ if defined $_ } undef } sub requireProperty { my $this = shift; my $prop = $this->getProperty(@_); defined $prop or die "required property '$_[0]' not found on configuration file\n"; return $prop; } sub _property_line_number { my ($self, $key)=@_; $self->{property_line_numbers}{$key} } # propertyName() - Returns an array of the keys of the Properties sub propertyNames { my $self = shift; my %p = $self->_properties; $self->_sort_keys(keys %p); } 1; __END__ =head1 NAME Config::Properties - Read and write property files =head1 SYNOPSIS use Config::Properties; # reading... open my $fh, '<', 'my_config.props' or die "unable to open configuration file"; my $properties = Config::Properties->new(); $properties->load($fh); $value = $properties->getProperty($key); # saving... open my $fh, '>', 'my_config.props' or die "unable to open configuration file for writing"; $properties->setProperty($key, $value); $properties->format('%s => %s'); $properties->store($fh, $header ); =head1 DESCRIPTION Config::Properties is a near implementation of the java.util.Properties API. It is designed to allow easy reading, writing and manipulation of Java-style property files. The format of a Java-style property file is that of a key-value pair separated by either whitespace, the colon (:) character, or the equals (=) character. Whitespace before the key and on either side of the separator is ignored. Lines that begin with either a hash (#) or a bang (!) are considered comment lines and ignored. A backslash (\) at the end of a line signifies a continuation and the next line is counted as part of the current line (minus the backslash, any whitespace after the backslash, the line break, and any whitespace at the beginning of the next line). The official references used to determine this format can be found in the Java API docs for java.util.Properties at L. When a property file is saved it is in the format "key=value" for each line. This can be changed by setting the format attribute using either $object->format( $format_string ) or $object->setFormat( $format_string ) (they do the same thing). The format string is fed to printf and must contain exactly two %s format characters. The first will be replaced with the key of the property and the second with the value. The string can contain no other printf control characters, but can be anything else. A newline will be automatically added to the end of the string. The current format string can be obtained by using $object->format() (with no arguments) or $object->getFormat(). If a recent version of L is available, long lines are conveniently wrapped when saving. =head1 METHODS C objects have this set of methods available: =over 4 =item Config::Properties-Enew(%opts) Creates a new Config::Properties object. The optional arguments are as follows: =over 4 =item file => $filename Opens and reads the entries from the given properties file =item format => $format Sets the format using for saving the properties to a file. See L. =item wrap => 0 Disables wrapping of long lines when saving the properties to a file. =item defaults => $defaults Default configuration values. The given parameter can be a hash reference or another Config::Properties object. In that way several configuration objects can be chained. For instance: my %defaults = (...); my $global_config = Config::Properties->new(file => '/etc/foo.properties', defaults => \%defaults); my $user_config = Config::Properties->new(file => '/home/jsmith/.foo/foo.properties', defaults => $global_config); =item order => 'keep'|'alpha'|'none' Sets how to order the properties when saved to a file or when returned by C and C methods. C sorts the keys in alphanumeric order. C keeps the order of the properties as added or read from a file. C returns the properties unordered. =item encoding => $encoding IO encoding used to read the configuration file. See L. When C is called the given encoding is used unless the file handler already has a encoding layer applied. C is used as the default encoding (as specified in the Java properties specification). =item be_like_java => 1 When this feature is enabled, the module will try to mimic the Java implementation as much as possible when saving files. Currently, some escaping rules are changed and line wrapping is disabled. =back =item Config::Properties-Enew($defaults) Calling C in this way is deprecated. =item $p-EgetProperty($k, $default, $default2, ...) return property C<$k> or when not defined, the first defined C<$default*>. =item $p-ErequireProperty($k, $default, $default2, ...) this method is similar to C but dies if the requested property is not found. =item $p-EsetProperty($k, $v) set property C<$k> value to C<$v>. =item $p-EchangeProperty($k, $v) =item $p-EchangeProperty($k, $v, $default, $default2, ...) method similar to C but that does nothing when the new value is equal to the one returned by C. An example shows why it is useful: my $defaults=Config::Properties->new(); $defaults->setProperty(foo => 'bar'); my $p1=Config::Properties->new($defaults); $p1->setProperty(foo => 'bar'); # we set here! $p1->store(FILE1); foo gets saved on the file my $p2=Config::Properties->new($defaults); $p2->changeProperty(foo => 'bar'); # does nothing! $p2->store(FILE2); # foo doesn't get saved on the file =item $p-EdeleteProperty($k) =item $p-EdeleteProperty($k, $recurse) deletes property $k from the object. If C<$recurse> is true, it also deletes any C<$k> property from the default properties object. =item $p-Eproperties returns a flatten hash with all the property key/value pairs, i.e.: my %props=$p->properties; =item $p-EgetProperties returns a hash reference with all the properties (including those passed as defaults). =item $p-EpropertyNames; returns the names of all the properties (including those passed as defaults). =item $p-EsplitToTree() =item $p-EsplitToTree($regexp) =item $p-EsplitToTree($regexp, $start) builds a tree from the properties, splitting the keys with the regular expression C<$re> (or C by default). For instance: my $data = <load(); my $tree = $cfg->splitToTree(); makes... $tree = { date => { birth => '1958-09-12', death => '2004-05-11' }, name => 'pete', surname => { '' => 'moo', length => '3' } }; The C<$start> parameter allows to split only a subset of the properties. For instance, with the same data as on the previous example: my $subtree = $cfg->splitToTree(qr/\./, 'date'); makes... $tree = { birth => '1958-09-12', death => '2004-05-11' }; =item $p-EsetFromTree($tree) =item $p-EsetFromTree($tree, $separator) =item $p-EsetFromTree($tree, $separator, $start) This method sets properties from a tree of Perl hashes and arrays. It is the opposite of C. C<$separator> is the string used to join the parts of the property names. The default value is a dot (C<.>). C<$start> is a string used as the starting point for the property names. For instance: my $c = Config::Properties->new; $c->setFromTree( { foo => { '' => one, hollo => [2, 3, 4, 1] }, bar => 'doo' }, '->', 'mama') # sets properties: # mama->bar = doo # mama->foo = one # mama->foo->hollo->0 = 2 # mama->foo->hollo->1 = 3 # mama->foo->hollo->2 = 4 # mama->foo->hollo->3 = 1 =item $p-EchangeFromTree($tree) =item $p-EchangeFromTree($tree, $separator) =item $p-EchangeFromTree($tree, $separator, $start) similar to C but internally uses C instead of C to set the property values. =item $p-Eload($file) loads properties from the open file C<$file>. Old properties on the object are discarded. =item $p-Esave($file) =item $p-Esave($file, $header) =item $p-Estore($file) =item $p-Estore($file, $header) save the properties to the open file C<$file>. Default properties are not saved. =item $p-EsaveToString($header) similar to C, but instead of saving to a file, it returns a string with the content. =item $p-EgetFormat() =item $p-EsetFormat($f) Xget/set the format string used when saving the object to a file. =back =head1 SEE ALSO Java docs for C at L. L for a simpler alternative interface to L. =head1 TODO Add support for derived format as supported by Java class org.apache.commons.configuration.PropertiesConfiguration (L) =head1 AUTHORS C was originally developed by Randy Jay Yarger. It was maintained for some time by Craig Manley and finally it passed hands to Salvador FandiEo , the current maintainer. =head1 COPYRIGHT AND LICENSE Copyright 2001, 2002 by Randy Jay Yarger Copyright 2002, 2003 by Craig Manley. Copyright 2003-2009, 2011-2012, 2014-2015 by Salvador FandiEo. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. =cut Config-Properties-1.80/MANIFEST0000644000175000017500000000046312525102212015123 0ustar salvasalvaMANIFEST README Changes Makefile.PL lib/Config/Properties.pm t/1_parse.t t/2_error.t t/3_valid.t t/4_invalid.t t/5_save.t t/6_sorted.t t/utf8.t META.yml Module meta-data (added by MakeMaker) META.json Module JSON meta-data (added by MakeMaker) Config-Properties-1.80/Makefile.PL0000644000175000017500000000105112522634700015747 0ustar salvasalvause 5.006; use ExtUtils::MakeMaker; my %opts = ( NAME => 'Config::Properties', VERSION_FROM => 'lib/Config/Properties.pm', ABSTRACT_FROM => 'lib/Config/Properties.pm', PREREQ_PM => { 'Test::More' => 0, 'File::Temp' => 0, 'Text::Wrap' => '2001.0929' }); $opts{META_MERGE} = { resources => { repository => 'https://github.com/salva/p5-Config-Properties' } } if $ExtUtils::MakeMaker::VERSION >= 6.46; WriteMakefile(%opts); Config-Properties-1.80/README0000644000175000017500000000256212522635241014666 0ustar salvasalvaConfig::Properties ================== Description ----------- Config::Properties is a near implementation of the java.util.Properties API. It is designed to allow easy reading, writing and manipulation of Java-style property files. The format of a Java-style property file is that of a key-value pair seperated by either whitespace, the colon (:) character, or the equals (=) character. Whitespace before the key and on either side of the seperator is ignored. Lines that begin with either a hash (#) or a bang (!) are considered comment lines and ignored. A backslash (\) at the end of a line signifies a continuation and the next line is counted as part of the current line (minus the backslash, any whitespace after the backslash, the line break, and any whitespace at the beginning of the next line). When a property file is saved it is in the format "key=value" for each line. Read the POD documentation for more fine details! Installation ------------ > perl Makefile.PL > make ... and if you like > make test ... and then > make install > perldoc Config::Properties Copyright --------- Copyright (c) 2001 Randy Jay Yarger. All Rights Reserved. Copyright (c) 2002 Craig Manley Copyright (c) 2003-2009, 2011-2012, 2014-2015 Salvador Fandiño This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Config-Properties-1.80/META.yml0000664000175000017500000000112312525102212015237 0ustar salvasalva--- abstract: 'Read and write property files' author: - unknown build_requires: ExtUtils::MakeMaker: '0' configure_requires: ExtUtils::MakeMaker: '0' dynamic_config: 1 generated_by: 'ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.150001' license: unknown meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: '1.4' name: Config-Properties no_index: directory: - t - inc requires: File::Temp: '0' Test::More: '0' Text::Wrap: '2001.0929' resources: repository: https://github.com/salva/p5-Config-Properties version: '1.80' Config-Properties-1.80/META.json0000664000175000017500000000203312525102212015410 0ustar salvasalva{ "abstract" : "Read and write property files", "author" : [ "unknown" ], "dynamic_config" : 1, "generated_by" : "ExtUtils::MakeMaker version 7.04, CPAN::Meta::Converter version 2.150001", "license" : [ "unknown" ], "meta-spec" : { "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec", "version" : "2" }, "name" : "Config-Properties", "no_index" : { "directory" : [ "t", "inc" ] }, "prereqs" : { "build" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "configure" : { "requires" : { "ExtUtils::MakeMaker" : "0" } }, "runtime" : { "requires" : { "File::Temp" : "0", "Test::More" : "0", "Text::Wrap" : "2001.0929" } } }, "release_status" : "stable", "resources" : { "repository" : { "url" : "https://github.com/salva/p5-Config-Properties" } }, "version" : "1.80" }