/usr/share/perl5/vendor_perl/Fedora/ Current File: //usr/share/perl5/vendor_perl/Fedora/VSP.pm
package Fedora::VSP;
our $VERSION = 0.001;

use strict;
use warnings;

=encoding utf8

=head1 NAME

Fedora::VSP - Perl version normalization for RPM

=head1 DESCRIPTION

This module provides functions for normalizing Perl version strings for Red Hat Package (RPM) based Linux distributions.

RPM version format and semantics is similar to Perl version strings (vX.Y.Z).
But to exactly. Older Perl's fraction version format (X.YZ) is incompatible
with RPM.

This is an effort to map Perl version strings to RPM version strings.

=head1 FUNCTIONS

=head2 vsp(I<STRING>, I<SHORT>)

Convert a version value into version string format. The output value is
stripped from the leading C<v> symbol.

If conversion fails, C<undef> will be returned.

Empty or undefined string will be normalized to C<undef>.

If I<SHORT> is true, the returned version string will be shortened by cutting
trailing zero groups. If no digit would remain, C<undef> will be returned.
This feature ephases brevity.

=cut

sub vsp {
    my ($input, $short) = @_;

    if (!defined $input) {
        return undef;
    }

    # Remove underscore parts
    $input =~ s/_.*//;

    if (!defined $input || $input eq '') {
        return undef;
    }

    # Dot is a delimiter
    my @parts = split(/\./, $input);
    # XXX: splitting '.' returns (), splitting '.1' returns ('', '1'),
    # handle them specially
    if (@parts == 0) {
        @parts = ('0');
    } elsif ($parts[0] eq '') {
        $parts[0] = '0';
    }

    # Preserve leading part
    my $output = shift @parts;

    # Is this version string or fraction string?
    my $is_vstring = $output =~ s/^v// || @parts != 1;

    # Reformat parts after leading dot
    if (!$is_vstring) {
        # If it's not a vstring and there is only one part after leading
        # dot, it's a fraction number
        my $fraction = $parts[0];
        @parts = ();

        # Augment digits to factor of 3
        my @digits = split('', $fraction);
        my $trailer = ($#digits + 1) % 3;
        if ($trailer) {
            push @digits, '0';
            if ($trailer == 1) {
                push @digits, '0';
            }
        }

        # Split it into triples
        my $i = 0;
        my $triple = '';
        for (@digits) {
            $i++;
            $triple .= $_;
            if ($i == 3) {
                $i = 0;
                push @parts, $triple;
                $triple = '';
            }
        }
    }

    # Append necessary number of parts to get X.Y.Z format
    if (@parts < 2) {
        push @parts, '0';
        if (@parts < 2) {
            push @parts, '0';
        }
    }

    # Concatenate parts
    for my $part (@parts) {
        # Strip leading zeros
        $part =~ s/^0*(?=.)//;
        $output .= '.' . $part;
    }

    # Shorten if requested
    if ($short) {
        # Cut off all trailing zero groups
        $output =~ s/(?:\.0*)*$//;
        # Drop 0 integer
        if ($output =~ /^0+\.?$/) {
            $output = undef;
        }
    }

    return $output;
}

=head1 AUTHOR

Petr Písař <ppisar@redhat.com>

=head1 COPYING

Copyright (C) 2015  Petr Písař <ppisar@redhat.com>

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 3 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, see <http://www.gnu.org/licenses/>.

=cut