The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
package Siebel::AssertOS::Linux::Distribution;

use 5.006000;
use strict;
use warnings;

require Exporter;

our @ISA = qw(Exporter);

our @EXPORT_OK = qw( distribution_name distribution_version );

our $VERSION = '0.01';

our $release_files_directory = '/etc';
our $standard_release_file   = 'lsb-release';

our %release_files = (
    'gentoo-release'        => 'gentoo',
    'fedora-release'        => 'fedora',
    'centos-release'        => 'centos',
    'enterprise-release'    => 'oracle enterprise linux',
    'turbolinux-release'    => 'turbolinux',
    'mandrake-release'      => 'mandrake',
    'mandrakelinux-release' => 'mandrakelinux',
    'debian_version'        => 'debian',
    'debian_release'        => 'debian',
    'SuSE-release'          => 'suse',
    'knoppix-version'       => 'knoppix',
    'yellowdog-release'     => 'yellowdog',
    'slackware-version'     => 'slackware',
    'slackware-release'     => 'slackware',
    'redflag-release'       => 'redflag',
    'redhat-release'        => 'redhat',
    'redhat_version'        => 'redhat',
    'conectiva-release'     => 'conectiva',
    'immunix-release'       => 'immunix',
    'tinysofa-release'      => 'tinysofa',
    'trustix-release'       => 'trustix',
    'adamantix_version'     => 'adamantix',
    'yoper-release'         => 'yoper',
    'arch-release'          => 'arch',
    'libranet_version'      => 'libranet',
    'va-release'            => 'va-linux',
    'pardus-release'        => 'pardus',
);

our %version_match = (
    'gentoo'  => 'Gentoo Base System release (.*)',
    'debian'  => '(.+)',
    'suse'    => 'VERSION = (.*)',
    'fedora'  => 'Fedora(?: Core)? release (\d+) \(',
    'redflag' => 'Red Flag (?:Desktop|Linux) (?:release |\()(.*?)(?: \(.+)?\)',
    'redhat'  => 'Red Hat(?: Enterprise)? Linux(?: Server)? release (.*) \(',
    'oracle enterprise linux' => 'Enterprise Linux Server release (.+) \(',
    'slackware'               => '^Slackware (.+)$',
    'pardus'                  => '^Pardus (.+)$',
    'centos'     => '^CentOS(?: Linux)? release (.+)(?:\s\(Final\))',
    'scientific' => '^Scientific Linux release (.+) \(',
);

if ( $^O ne 'linux' ) {

#	require Carp;
#	Carp::croak('you are trying to use a linux specific module on a different OS');
}

sub new {
    my %self = (
        'DISTRIB_ID'          => '',
        'DISTRIB_RELEASE'     => '',
        'DISTRIB_CODENAME'    => '',
        'DISTRIB_DESCRIPTION' => '',
        'release_file'        => '',
        'pattern'             => ''
    );

    return bless \%self;
}

sub distribution_name {
    my $self = shift || new();
    my $distro;
    if ( $distro = $self->_get_lsb_info() ) {
        return $distro if ($distro);
    }

    foreach (qw(enterprise-release fedora-release)) {
        if ( -f "$release_files_directory/$_"
            && !-l "$release_files_directory/$_" )
        {
            if ( -f "$release_files_directory/$_"
                && !-l "$release_files_directory/$_" )
            {
                $self->{'DISTRIB_ID'}   = $release_files{$_};
                $self->{'release_file'} = $_;
                return $self->{'DISTRIB_ID'};
            }
        }
    }

    foreach ( keys %release_files ) {
        if ( -f "$release_files_directory/$_"
            && !-l "$release_files_directory/$_" )
        {
            if ( -f "$release_files_directory/$_"
                && !-l "$release_files_directory/$_" )
            {
                if ( $release_files{$_} eq 'redhat' ) {
                    foreach my $rhel_deriv ( 'centos', 'scientific', ) {
                        $self->{'pattern'}      = $version_match{$rhel_deriv};
                        $self->{'release_file'} = 'redhat-release';
                        if ( $self->_get_file_info() ) {
                            $self->{'DISTRIB_ID'}   = $rhel_deriv;
                            $self->{'release_file'} = $_;
                            return $self->{'DISTRIB_ID'};
                        }
                    }
                    $self->{'pattern'} = '';
                }
                $self->{'release_file'} = $_;
                $self->{'DISTRIB_ID'}   = $release_files{$_};
                return $self->{'DISTRIB_ID'};
            }
        }
    }
    undef;
}

sub distribution_version {
    my $self = shift || new();
    my $release;
    return $release if ( $release = $self->_get_lsb_info('DISTRIB_RELEASE') );
    if ( !$self->{'DISTRIB_ID'} ) {
        $self->distribution_name() or die 'No version because no distro.';
    }
    $self->{'pattern'}         = $version_match{ $self->{'DISTRIB_ID'} };
    $release                   = $self->_get_file_info();
    $self->{'DISTRIB_RELEASE'} = $release;
    return $release;
}

sub _get_lsb_info {
    my $self  = shift;
    my $field = shift || 'DISTRIB_ID';
    my $tmp   = $self->{'release_file'};
    if ( -r "$release_files_directory/" . $standard_release_file ) {
        $self->{'release_file'} = $standard_release_file;
        $self->{'pattern'}      = $field . '=(.+)';
        my $info = $self->_get_file_info();
        if ($info) {
            $self->{$field} = $info;
            return $info;
        }
    }
    $self->{'release_file'} = $tmp;
    $self->{'pattern'}      = '';
    undef;
}

sub _get_file_info {
    my $self = shift;
    open my $fh, '<', "$release_files_directory/" . $self->{'release_file'}
      or die 'Cannot open file: '
      . $release_files_directory . '/'
      . $self->{'release_file'};
    my $info = '';
    local $_;
    while (<$fh>) {
        chomp $_;
        ($info) = $_ =~ m/$self->{'pattern'}/;
        return "\L$info" if $info;
    }
    undef;
}

1;
__END__

=head1 NAME

Siebel::AssertOS::Linux::Distribution - detect if the Linux distribution supports Siebel CRM.

=head1 DESCRIPTION

This module is a copy from L<Linux::Distribution> version 0.21. This had to be done because the original distribution checks in the Makefile.PL
if the operation system trying to install is Linux, which in the case is the correct procedure as described in L<http://wiki.cpantesters.org/wiki/CPANAuthorNotes>.

Unfortunately, L<Siebel::AssertOS> must consider first if the OS is Linux or not, then check other supported OS (if not).

Maybe in the future L<Siebel::AssertOS> can go back only using L<Linux::Distribution> directly.

=head2 EXPORT

None by default.

=head1 SEE ALSO

L<Linux::Distribution>

=head1 AUTHORS

Alceu Rodrigues de Freitas Junior, E<lt>arfreitas@cpan.orgE<gt>

=head1 COPYRIGHT AND LICENSE

This software is copyright (c) 2013 of Alceu Rodrigues de Freitas Junior, E<lt>arfreitas@cpan.org<E<gt>

This file is part of Siebel COM project.

Siebel COM 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.

Siebel COM 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 Siebel COM.  If not, see <http://www.gnu.org/licenses/>.

=cut