view release on metacpan or  search on metacpan

lib/Sys/Info/Driver/Linux/OS/Distribution.pm  view on Meta::CPAN

    my $slot_release = $slot->{release}
        ? ref $slot->{release} eq 'ARRAY' ? $slot->{release}[0] : $slot->{release}
        : undef
        ;

    local $self->{release_file} = $slot_release if $slot_release;

    my $vrelease = $self->_get_file_info;

    # Set to the original if we got any, othwerwise try the version
    $self->{DISTRIB_RELEASE} = $release || $vrelease;

    # Opposite of above as we want a version number
    # if we were able locate one
    return $vrelease || $release;
}

sub _probe_edition {
    my $self = shift;
    my $p    = $self->{PROBE};

    if ( my $dn = $self->name ) {
        my $n = $self->{DISTRIB_NAME} || do {
            my $slot = $CONF{ $dn };
            exists $slot->{name} ? $slot->{name} : ucfirst $dn;
        };
        $dn  = $self->trim( $n );
        $dn .= ' Linux' if $dn !~ m{Linux}xmsi;
        $self->{RESULTS}{name} = $dn;
    }
    else {
        $self->{RESULTS}{name}    = $p->{distro};
        $self->{RESULTS}{version} = $p->{kernel};
    }

    my $name     = $self->name;
    my $raw_name = $self->raw_name;
    my $version  = $self->version;
    my $slot     = $CONF{$raw_name} || return;

    my $int_version = int($version) . '.0';
    my $edition;

    if ( exists $slot->{edition} ) {
        my $this_ve = $slot->{edition}{ $version };
        if ( $this_ve ) {
            $edition = $this_ve;
        }
        elsif ( my $this_ie = $slot->{edition}{$int_version} ) {
            $edition = $this_ie;
        }
        else {
            # warn?
        }
    }

    if ( ! $edition ) {
        if ( $version && $version !~ m{[0-9]}xms ) {
            if ( $name =~ m{debian}xmsi ) {
                my @buf = split m{/}xms, $version;
                if ( my $test = $CONF{debian}->{vfix}{ lc $buf[0] } ) {
                    # Debian version comes as the edition name
                    $edition = $version;
                    $self->{RESULTS}{version} = $test;
                }
            }
        }
        else {
            if (   $slot->{use_codename_for_edition}
                && $self->{DISTRIB_CODENAME}
            ) {
                my $cn = $self->{DISTRIB_CODENAME};
                $edition = $cn if $cn !~ m{[0-9]}xms;
            }
        }
    }

    return $edition;
}

sub _initial_probe {
    my $self    = shift;
    my $version = q{};

    if (  -e proc->{version} && -f _) {
        $version =  $self->trim(
                        $self->slurp(
                            proc->{version},
                            'I can not open linux version file %s for reading: '
                        )
                    );
    }

    my($str, $build_date) = split /\#/xms, $version;
    my($kernel, $distro)  = (q{},q{});

    #$build_date = "1 Fri Jul 23 20:48:29 CDT 2004';";
    #$build_date = "1 SMP Mon Aug 16 09:25:06 EDT 2004";
    $build_date = q{} if not $build_date; # running since blah thingie

    if ( $str =~ RE_LINUX_VERSION || $str =~ RE_LINUX_VERSION2 ) {
        $kernel = $1;
        if ( $distro = $self->trim( $2 ) ) {
            if ( $distro =~ m{ \s\((.+?)\)\) \z }xms ) {
                $distro = $1;
            }
        }
    }

    $distro = 'Linux' if ! $distro || $distro =~ m{\(gcc}xms;

    # kernel build date
    $build_date = $self->date2time($build_date) if $build_date;
    my $build   = $build_date ? localtime $build_date : q{};

    $self->{PROBE} = {
        version    => $version,
        kernel     => $kernel,
        build      => $build,
        build_date => $build_date,
        distro     => $distro,
    };

    $self->_probe;
    return;
}

sub _get_lsb_info {
    my $self  = shift;
    my $field = shift || 'DISTRIB_ID';
    my $tmp   = $self->{release_file};

    my($rfile) = grep { -r $_->[1] }
                map  {
                    [ $_ => File::Spec->catfile( $self->{etc_dir}, $_ ) ]
                }
                STD_RELEASE,
                DEBIAN_RELEASE
                ;

    if ( $rfile ) {
        $self->{release_file} = $rfile->[0];
        $self->{pattern}      = $field . '=(.+)';
        my $info = $self->_get_file_info;
        return $self->{$field} = $info if $info;
    }
    else {
        # CentOS6+? RHEL? Any new distro?
        my $dir = File::Spec->catdir( $self->{etc_dir}, STD_RELEASE_DIR );
        if ( -d $dir ) {
            my $rv = join q{: },
                     map  { m{$dir/(.*)}xms ? $1 : () }
                     grep { $_ !~ m{ \A [.] }xms }
                     glob "$dir/*";
            $self->{LSB_VERSION} = $rv if $rv;
        }
        my($release) = do {
            if ( my @files = glob $self->{etc_dir} . "/*release" ) {
                my($real) = sort grep { ! -l } @files;
                my %uniq  = map { $self->trim( $self->slurp( $_ ) ) => 1 }
                            @files;
                if ( $real ) {
                    my $etc = $self->{etc_dir};
                    ($self->{release_file} = $real) =~ s{$etc/}{}xms;
                    $self->{pattern}       = '(.+)';
                }
                keys %uniq;
            }
        };

        return if ! $release; # huh?

        my($rname) = split m{\-}xms, $self->{release_file};
        my($distrib_id, @rest)  = split m{release}xms, $release, 2;
        my($version, $codename) = split m{ \s+   }xms, $self->trim( join ' ', @rest ), 2;
        $codename   =~ s{[()]}{}xmsg if $codename;
        $distrib_id = $self->trim( $distrib_id );
        $self->{DISTRIB_DESCRIPTION} = $release;
        $self->{DISTRIB_ID}          = $rname || $distrib_id;
        $self->{DISTRIB_NAME}        = $distrib_id;
        $self->{DISTRIB_RELEASE}     = $version;
        $self->{DISTRIB_CODENAME}    = $codename || q{};

        # fix stupidity
        if (   $self->{DISTRIB_ID}
            && $self->{DISTRIB_ID} eq 'redhat'
            && $self->{DISTRIB_NAME}
            && index($self->{DISTRIB_NAME}, 'CentOS') != -1
        ) {
            $self->{DISTRIB_ID} = 'centos';
        }

        return $self->{ $field } if $self->{ $field };
    }

    $self->{release_file} = $tmp;
    $self->{pattern}      = q{};
    return;
}

sub _get_file_info {
    my $self = shift;
    my $file = File::Spec->catfile( $self->{etc_dir}, $self->{release_file} );
    require IO::File;
    my $FH = IO::File->new;
    $FH->open( $file, '<' ) || croak "Can't open $file: $!";
    my @raw = <$FH>;
    $FH->close || croak "Can't close FH($file): $!";
    my $new_pattern =
          $self->{pattern} =~ m{ \A DISTRIB_ID      \b }xms ? '^ID=(.+)'
        : $self->{pattern} =~ m{ \A DISTRIB_RELEASE \b }xms ? '^PRETTY_NAME=(.+)'
        : undef;
    my $rv;
    foreach my $line ( @raw ){
        chomp $line;
        next if ! $line;

        ## no critic (RequireExtendedFormatting)
        my($info) = $line =~ m/$self->{pattern}/ms;
        if ( $info ) {
            $rv = "\L$info";
            last;
        }
        elsif ( $new_pattern ) {
            ## no critic (RequireExtendedFormatting)
            my($info2) = $line =~ m/$new_pattern/ms;
            if ( $info2 ) {
                $rv = "\L$info2";
                last;
            }
        }
    }

    if ( $rv ) {
        $rv =~ s{ \A ["]    }{}xms;