# Copyright (C) 2018 Felix Lechner # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program. If not, you can find it on the World Wide # Web at https://www.gnu.org/copyleft/gpl.html, or write to the Free # Software Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, # MA 02110-1301, USA package Test::Lintian::ConfigFile; =head1 NAME Test::Lintian::ConfigFile -- generic helper routines for colon-delimited configuration files =head1 SYNOPSIS use Test::Lintian::ConfigFile qw(read_config); my $desc = read_config('t/tags/testname/desc'); =head1 DESCRIPTION Routines for dealing with colon-delimited configuration files. =cut use v5.20; use warnings; use utf8; use Exporter qw(import); BEGIN { our @EXPORT_OK = qw( read_config write_config ); } use Carp; use Const::Fast; use List::SomeUtils qw(any); use Path::Tiny; use Unicode::UTF8 qw(encode_utf8); use Lintian::Deb822; const my $SPACE => q{ }; const my $COLON => q{:}; const my $NEWLINE => qq{\n}; =head1 FUNCTIONS =over 4 =item read_config(PATH, HASHREF) Reads the configuration file located at PATH into a hash and returns it. When also passed a HASHREF, will fill that instead. =cut sub read_config { my ($configpath) = @_; croak encode_utf8("Cannot find file $configpath.") unless -e $configpath; my $deb822 = Lintian::Deb822->new; my @sections = $deb822->read_file($configpath); die encode_utf8("$configpath does not have exactly one paragraph") unless @sections == 1; my $config = $sections[0]; return $config; } =item write_config(TEST_CASE, PATH) Write the config described by hash reference TEST_CASE to the file named PATH. =cut sub write_config { my ($testcase, $path) = @_; my $desc = path($path); $desc->remove; my @lines; for my $name (sort $testcase->names) { my @elements = $testcase->trimmed_list($name); # multi-line output for some fields if (@elements > 1 && any { fc eq fc($name) } qw(Test-For Test-Against)) { push(@lines, $name . $COLON . $NEWLINE); push(@lines, $SPACE . $_ . $NEWLINE) for @elements; next; } push(@lines, $name . $COLON . $SPACE . $testcase->value($name) . $NEWLINE); } $desc->append_utf8(@lines); return; } =back =cut 1; # Local Variables: # indent-tabs-mode: nil # cperl-indent-level: 4 # End: # vim: syntax=perl sw=4 sts=4 sr et