/usr/share/perl5/Config/Model/Backend/DpkgStoreRole.pm is in libconfig-model-dpkg-perl 2.090.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 | package Config::Model::Backend::DpkgStoreRole ;
use strict;
use warnings;
use Mouse::Role;
use Carp;
use Config::Model::Exception ;
use Log::Log4perl qw(get_logger :levels);
use 5.20.0;
use feature qw/postderef signatures/;
no warnings qw/experimental::postderef experimental::signatures/;
# push data on list, does not clear
sub store_section_list_element ($self, $logger, $list_obj, $check, $v_ref) {
# v_ref is a list of ($value, $line_nb ,$note,@comment)
my $idx = $list_obj->fetch_size;
my @list_comment;
foreach my $v_info ( $v_ref->@* ) {
if (ref $v_info) {
my ($v,$l,$note,@c) = @$v_info;
# $v can be ' foo,' or 'foo, bar, baz'. This depends on input format
# there can only be one comment for all these values (constrained by syntax)
$v =~ s/\s*,\s*$//;
$v =~ s/^\s+//;
my @items = split /\s*,\s*/, $v;
my $comment = join("\n", @c);
my $item_idx = 0;
foreach my $item (@items) {
$logger->debug( "list store $idx:'$item'" . ($comment ? " comment '$comment'" : ''));
my $elt_obj = $list_obj->fetch_with_id($idx++);
$elt_obj->store( $item, check => $check );
$elt_obj->annotation($comment) if $comment and $item_idx++ == 0;
$elt_obj->notify_change(note => $note, really => 1) if $note ;
}
}
else {
push @list_comment, $v_info if $v_info;
}
}
$list_obj->annotation(@list_comment) if @list_comment;
}
sub store_section_leaf_element ($self, $logger, $elt_obj, $check, $v_ref) {
# v_ref is a list of (@comment , [ value, $line_nb ,$note ] )
my $value_type = $elt_obj->value_type;
my (@v,@comment,@note);
foreach my $v_item ( $v_ref ->@* ) {
if (ref $v_item) {
push @v, $v_item->[0] if $value_type eq 'string' or $v_item->[0] =~ /\S/;
push @note, $v_item->[2] if $v_item->[2];
}
elsif ($v_item) {
push @comment, $v_item;
}
}
my $v = join("\n", @v);
my $note = join("\n", @note);
$logger->debug("storing ",$elt_obj->element_name," value: $v");
$elt_obj->store( value => $v, check => $check );
$elt_obj->annotation(@comment) if @comment ;
$elt_obj->notify_change(note => $note, really => 1) if $note ;
}
1;
|