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

package Jenkins::i18n::Properties;

use 5.014004;
use strict;
use warnings;
use Carp qw(confess);
use parent 'Config::Properties';

our $VERSION = '0.08';

=pod

=head1 NAME

Jenkins::i18n::Properties - a subclass of L

=head1 SYNOPSIS

  use Jenkins::i18n::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

C is a subclass of L and works
pretty much the same, except regarding the C method, which is overrided.

=head2 EXPORT

None by default.

=head1 METHODS

=head2 save

This is an overrided method from the parent class.

It expects to receive the following positional parameters:

=over

=item 1.

A opened file handle created with C.

=item 2.

An array reference with the license content to include in the properties file.

=back

Both are required.

This method, differently from the original of the parent class, does not
include a timestamp with C.

This method B closes the given filehand at the end of the writting.

=cut

sub save {
    my ( $self, $fh, $license_ref ) = @_;
    confess "a file handle is a required parameter" unless ($fh);
    confess "license is a required parameter"       unless ($license_ref);
    confess "license must be an array reference"
        unless ( ref($license_ref) eq 'ARRAY' );

    foreach my $line ( @{$license_ref} ) {

        # the license is expected to have lines starting with
        # a space and with a new line at the end
        print $fh "#$line";
    }

    print $fh "\n";
    $self->_save($fh);
}

=head2 unescape

Remove escape characters from a string.

Expects a single string parameter, changing it in place.

=cut

sub unescape {
    my $text  = shift;
    my %unesc = (
        n => "\n",
        r => "\r",
        t => "\t",
    );

    $text =~ s/\\([tnr\\"' =:#!])|\\u([\da-fA-F]{4})/
        defined $1 ? $unesc{$1}||$1 : chr hex $2 /ge;
}

=head2 process_line

This is a method overrided from the superclass.

Process a single line retrieved from the Java properties file, saving the key
and value internally.

Returns C<1> if everything goes fine.

This method was overrided to allow the key value to retain it's escape
characters, as required by Jenkins translation files.

Additionally, this method will not attempt to fix UTF-8 BOM from very old perl
interpreters (version 5.6.0).

=cut

sub process_line {
    my ( $self, $file ) = @_;
    my $line = $self->read_line($file);
    defined $line or return undef;

    my $ln = $self->{last_line_number};

    # 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;

        # TODO: replace this with String::Strip
        $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($value);
    $self->validate( $key, $value );

    $self->{property_line_numbers}{$key} = $ln;
    $self->{properties}{$key}            = $value;

    return 1;
}

sub _save {
    my ( $self, $file ) = @_;

    foreach my $key ( $self->_sort_keys( keys %{ $self->{properties} } ) ) {
        $file->print(
            sprintf( $self->{'format'}, $key, $self->{properties}->{$key} ),
            "\n" );
    }
}

1;
__END__