[libconfig-model-dpkg-perl] 04/06: Backend::Patch can cope with root arg without /

[dod at debian.org]

This is an automated email from the git hooks/post-receive script.

dod pushed a commit to annotated tag debian/2.105
in repository libconfig-model-dpkg-perl.

commit f96762798406ffad014789a279b78e862ecdfe97
Author: Dominique Dumont <dod at debian.org>
Date:   Fri Jan 19 20:54:19 2018 +0100

    Backend::Patch can cope with root arg without /
    
    Config::Model used to provide $args{root} for tests with a trailing
    slash.
    
    All Backends are being reworked to use Path::Tiny (and be simplified).
    
    WIth this commit, this backend can cope with old root arg (a string
    with trailing /) and new root arg (a Path::Tiny object that stringifies
    to a string *without* trailing slash)
    
    Path backend now uses Path::Tiny instead of IO::File
---
 lib/Config/Model/Backend/Dpkg/Patch.pm | 37 ++++++++++++++++++++++------------
 1 file changed, 24 insertions(+), 13 deletions(-)

diff --git a/lib/Config/Model/Backend/Dpkg/Patch.pm b/lib/Config/Model/Backend/Dpkg/Patch.pm
index 4792a5b..9023591 100644
--- a/lib/Config/Model/Backend/Dpkg/Patch.pm
+++ b/lib/Config/Model/Backend/Dpkg/Patch.pm
@@ -17,12 +17,24 @@ no warnings qw/experimental::postderef experimental::signatures/;
 use Carp;
 use Config::Model::Exception;
 use Log::Log4perl qw(get_logger :levels);
-use IO::File;
+use Path::Tiny;
 
 my $logger = get_logger("Backend::Dpkg::Patch");
 
 sub skip_open { 1;}
 
+# TODO: use a role provided by Config::Model
+sub cfg_path {
+    my $self = shift;
+    my %args = @_;
+    my $cfg_dir   = $args{config_dir};
+    my $dir
+        = $args{root}   ? path($args{root})->child($cfg_dir)
+        : ref($cfg_dir) ? $cfg_dir
+        :                 path( $cfg_dir);
+    return $dir;
+}
+
 sub read {
     my $self = shift;
     my %args = @_;
@@ -38,24 +50,23 @@ sub read {
 
     # io_handle is not defined as no file is specified in model
 
-    my $patch_dir = $args{root} . $args{config_dir};
+    my $cfg_dir   = $args{config_dir};
+    my $patch_dir = $self->cfg_path(%args);
+
     my $check     = $args{check};
     my $node      = $args{object};
 
     my $backend_arg = $self->instance->backend_arg;
     my $patch_name = $node->index_value || $backend_arg;
 
-    my $patch_file = "$patch_dir$patch_name" ;
+    my $patch_file = $patch_dir->child($patch_name) ;
     $self->{patch_file} = $patch_file;
 
     $logger->info("Parsing patch $patch_file");
-    my $patch_io = IO::File->new($patch_file)
-      || Config::Model::Exception::User->throw(message => "cannot read patch $patch_file: $!" );
-    $patch_io->binmode(':utf8');
 
     my ( $header, $diff ) = ( [],[] );
     my $target = $header;
-    foreach my $l ( $patch_io->getlines ) {
+    foreach my $l ( $patch_file->lines_utf8 ) {
         if ( $l =~ /^---/ ) {
             # beginning of quilt style patch
             $target = $diff;
@@ -82,7 +93,7 @@ sub read {
         $c = eval { $self->parse_dpkg_lines( $patch_file, $header, $check, 0, $store_stuff ); };
         my $e = $@;
         if ( ref($e) and $e->isa('Config::Model::Exception::Syntax') ) {
-            $e->parsed_file( $patch_file );
+            $e->parsed_file( $patch_file->stringify );
             $e->rethrow;
         }
         elsif (ref($e)) {
@@ -94,7 +105,7 @@ sub read {
 
         Config::Model::Exception::Syntax->throw(
             message => "More than 2 sections in $patch_name header",
-            parsed_file => $patch_file,
+            parsed_file => $patch_file->stringify,
         )
           if @$c > 4; # $c contains [ line_nb, section_ref ]
     }
@@ -166,10 +177,9 @@ sub write {
     my $patch_file =     $self->{patch_file} ;
     $logger->info("Writing patch $patch_file");
 
-    my $io = IO::File->new($patch_file,'w')
-      || Config::Model::Exception::Syntax->throw(
-        message => "cannot write patch $patch_file" );
-    $io->binmode(":utf8");
+    my $io = $patch_file->openw_utf8 || Config::Model::Exception::Syntax->throw(
+        message => "cannot write patch $patch_file"
+    );
 
     # first: write Description or Subject (where the subuject body is written
     # outside the structured part -- as required by dep-3)
@@ -223,6 +233,7 @@ sub write {
     }
 
     $io->print($node->fetch_element_value('diff')) ;
+    $io->close;
 
     return 1;
 }

-- 
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/libconfig-model-dpkg-perl.git