File Coverage

blib/lib/Jenkins/i18n/Properties.pm
Criterion Covered Total %
statement 50 50 100.0
branch 12 18 66.6
condition 2 6 33.3
subroutine 9 9 100.0
pod 3 3 100.0
total 76 86 88.3


line stmt bran cond sub pod time code
1             package Jenkins::i18n::Properties;
2              
3 8     8   140 use 5.014004;
  8         28  
4 8     8   40 use strict;
  8         16  
  8         153  
5 8     8   36 use warnings;
  8         13  
  8         245  
6 8     8   42 use Carp qw(confess);
  8         15  
  8         462  
7 8     8   2827 use parent 'Config::Properties';
  8         1925  
  8         50  
8              
9             our $VERSION = '0.09';
10              
11             =pod
12              
13             =head1 NAME
14              
15             Jenkins::i18n::Properties - a subclass of L
16              
17             =head1 SYNOPSIS
18              
19             use Jenkins::i18n::Properties;
20              
21             # reading...
22             open my $fh, '<', 'my_config.props'
23             or die "unable to open configuration file";
24             my $properties = Config::Properties->new();
25             $properties->load($fh);
26             $value = $properties->getProperty($key);
27              
28             # saving...
29             open my $fh, '>', 'my_config.props'
30             or die "unable to open configuration file for writing";
31             $properties->setProperty($key, $value);
32             $properties->format('%s => %s');
33             $properties->store($fh, $header );
34              
35             =head1 DESCRIPTION
36              
37             C is a subclass of L and works
38             pretty much the same, except regarding the C method, which is overrided.
39              
40             =head2 EXPORT
41              
42             None by default.
43              
44             =head1 METHODS
45              
46             =head2 save
47              
48             This is an overrided method from the parent class.
49              
50             It expects to receive the following positional parameters:
51              
52             =over
53              
54             =item 1.
55              
56             A opened file handle created with C.
57              
58             =item 2.
59              
60             An array reference with the license content to include in the properties file.
61              
62             =back
63              
64             Both are required.
65              
66             This method, differently from the original of the parent class, does not
67             include a timestamp with C.
68              
69             This method B closes the given filehand at the end of the writting.
70              
71             =cut
72              
73             sub save {
74 2     2 1 7 my ( $self, $fh, $license_ref ) = @_;
75 2 50       7 confess "a file handle is a required parameter" unless ($fh);
76 2 50       5 confess "license is a required parameter" unless ($license_ref);
77 2 50       7 confess "license must be an array reference"
78             unless ( ref($license_ref) eq 'ARRAY' );
79              
80 2         6 foreach my $line ( @{$license_ref} ) {
  2         6  
81              
82             # the license is expected to have lines starting with
83             # a space and with a new line at the end
84 10         29 print $fh "#$line";
85             }
86              
87 2         6 print $fh "\n";
88 2         16 $self->_save($fh);
89             }
90              
91             =head2 unescape
92              
93             Remove escape characters from a string.
94              
95             Expects a single string parameter, changing it in place.
96              
97             =cut
98              
99             sub unescape {
100 72     72 1 111 my $text = shift;
101 72         187 my %unesc = (
102             n => "\n",
103             r => "\r",
104             t => "\t",
105             );
106              
107 72         322 $text =~ s/\\([tnr\\"' =:#!])|\\u([\da-fA-F]{4})/
108 138 50 0     825 defined $1 ? $unesc{$1}||$1 : chr hex $2 /ge;
109             }
110              
111             =head2 process_line
112              
113             This is a method overrided from the superclass.
114              
115             Process a single line retrieved from the Java properties file, saving the key
116             and value internally.
117              
118             Returns C<1> if everything goes fine.
119              
120             This method was overrided to allow the key value to retain it's escape
121             characters, as required by Jenkins translation files.
122              
123             Additionally, this method will not attempt to fix UTF-8 BOM from very old perl
124             interpreters (version 5.6.0).
125              
126             =cut
127              
128             sub process_line {
129 240     240 1 58138 my ( $self, $file ) = @_;
130 240         461 my $line = $self->read_line($file);
131 240 100       6545 defined $line or return;
132              
133 228         361 my $ln = $self->{last_line_number};
134              
135             # ignore comments
136 228 100       768 $line =~ /^\s*(\#|\!|$)/ and return 1;
137              
138             # handle continuation lines
139 72         107 my @lines;
140 72   66     308 while ( $line =~ /(\\+)$/ and length($1) & 1 ) {
141 32         167 $line =~ s/\\$//;
142 32         65 push @lines, $line;
143 32         74 $line = $self->read_line($file);
144 32 50       675 $line = '' unless defined $line;
145              
146             # TODO: replace this with String::Strip
147 32         200 $line =~ s/^\s+//;
148             }
149 72 100       178 $line = join( '', @lines, $line ) if @lines;
150              
151 72 50       541 my ( $key, $value ) = $line =~ /^
152             \s*
153             ((?:[^\s:=\\]|\\.)+)
154             \s*
155             [:=\s]
156             \s*
157             (.*)
158             $
159             /x
160             or $self->fail("invalid property line '$line'");
161              
162 72         191 unescape($value);
163 72         230 $self->validate( $key, $value );
164              
165 72         472 $self->{property_line_numbers}{$key} = $ln;
166 72         145 $self->{properties}{$key} = $value;
167              
168 72         139 return 1;
169             }
170              
171             sub _save {
172 2     2   7 my ( $self, $file ) = @_;
173              
174 2         7 foreach my $key ( $self->_sort_keys( keys %{ $self->{properties} } ) ) {
  2         10  
175             $file->print(
176 4         105 sprintf( $self->{'format'}, $key, $self->{properties}->{$key} ),
177             "\n" );
178             }
179             }
180              
181             1;
182             __END__