view release on metacpan or  search on metacpan

lib/Sys/Info/Driver/OSX.pm  view on Meta::CPAN

}

sub _sysctl {
    my($key) = @_;

    my $success;
    my($out, $error) = capture {
        $success = ! system '/usr/sbin/sysctl' => $key;
    };

    my %rv;
    if ( $out ) {
        foreach my $row ( split RE_SYSCTL_SPLIT, $out ) {
            chomp $row;
            next if ! $row;
            my($name, $value) = _parse_sysctl_row( $row, $key );
            $rv{ $name } = $value;
        }
    }

    my $total = keys %rv;

    $error = __PACKAGE__->trim( $error ) if $error;

    return {
        value   => $total > 1 ? { %rv } : $rv{ $key },
        error   => $error,
        bogus   => $error ? _sysctl_not_exists( $error ) : 0,
        success => $success,
    };
}

sub _parse_sysctl_row {
    my($row, $key) = @_;
    my(undef, $name, $value) = split RE_SYSCTL_ROW, $row, 2;

    if ( ! defined $value || $value eq q{} ) {
        croak sprintf q(Can't happen: No value in output for property )
                     . q('%s' inside row '%s' collected from key '%s'),
                        $name || q([no name]),
                        $row,
                        $key;
    }

    return map { __PACKAGE__->trim( $_ ) } $name, $value;
}

sub _sysctl_not_exists {
    my($error) = @_;
    return if ! $error;
    foreach my $test ( SYSCTL_NOT_EXISTS ) {
        return 1 if $error =~ $test;
    }
    return 0;
}

sub powermetrics {
    my @opt = @_;
    if ( $< ) {
        croak sprintf 'powermetrics can only be executed as root and not %s (%s)',
                (getpwuid $<)[0],
                $<,
        ;
    }
    my $success;
    my($out, $error) = capture {
        $success = ! system "/usr/bin/powermetrics @opt";
    };

    $_ = __PACKAGE__->trim( $_ ) for $out, $error;

    croak "Unable to capture `powermetrics`: $error" if $error || ! $success;

    my @info = split m{ [\n]+ }xms, $out;
    my %info;

    for my $i ( @info ) {
        next if $i =~ m{ \A [*] }xms;
        my($k, $v) = split m{[:]}xms, $i, 2;

        $_ = __PACKAGE__->trim( $_ ) for $k, $v;

        if ( $v =~ m{ \[ }xms ) {
            my($subk, $subv) = split m{\s+}xms, $v, 2;
            my @subv = map {
                            s{ [\[\]] }{}xms;
                            split m{ [:] \s+ }xms, $_
                        }
                        split m{ \] \s+ \[ }xms, $subv
                    ;
            $info{ $subk } = { @subv };
        }
        elsif ( $k =~ m{ \QC-state residency\E }xms ) {
            my($subk, @subv) = split m{ [()] }xms, $v;
            @subv = map { split m{ [\s] }xms, $_ } @subv;
            $info{ $k } = {
                value => __PACKAGE__->trim( $subk ),
                map {
                    s{ [:] \s? }{}xms;
                    __PACKAGE__->trim( $_ )
                } @subv,
            };
        }
        else {
            $info{ $k } = $v;
        }
    }

    return %info;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME