view release on metacpan or  search on metacpan

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

;
use constant RE_SYSCTL_SPLIT   => qr{\n+}xms;
use constant RE_SYSCTL_ROW     => qr{
    \A
    ([a-zA-Z0-9_.]+) # this must be capturing parenthesis
    (?:\s+)?         # optional space
    [:=]             # the key name termination character
                     # new sysctl uses ":" to separate key/value pairs
}xms;

use Capture::Tiny qw( capture );
use Carp          qw( croak   );
use Mac::PropertyList;

our @EXPORT  = qw(
    fsysctl
    nsysctl
    plist
    powermetrics
    sw_vers
    system_profiler
    vm_stat
);

sub plist {
    my $thing = shift;
    my $raw   = $thing !~ m{\n}xms && -e $thing
              ? __PACKAGE__->slurp( $thing )
              : $thing;
    my($prop, $fatal);
    eval {
        $prop = Mac::PropertyList::parse_plist( $raw );
        1;
    } or do {
        $fatal = $@ || 'unknown error';
    };

    if ( ! $prop || $fatal ) {
        my $fmt = $fatal ? 'Unable to parse plist(%s): %s'
                :          'Unable to parse plist(%s)'
                ;
        croak sprintf $fmt, $thing, $fatal ? $fatal : ();
    }

    return $prop->as_perl;
}

#
# TODO: https://github.com/aosm/system_cmds/blob/master/vm_stat.tproj/vm_stat.c
#
sub vm_stat {
    my $success;
    my($out, $error) = capture {
        $success = ! system q{/usr/bin/vm_stat};
    };

    warn "vm_stat: $error\n"                   if $error;
    croak "vm_stat call failed!"               if ! $success;
    croak "vm_stat didn't generate any output" if ! $out;

    my @lines     = split m{\n+}, $out;
    my $page_size = shift @lines;

    if ( $page_size =~ m{
            \QMach Virtual Memory Statistics: (page size of\E
                \s (.+?) \s
            bytes\)
        }xms
    ) {
        $page_size = $1;
    }
    else {
        croak "Unable to determine page size from input";
    }

    pop @lines; # some junk info line

    my %rv;

    for my $line ( @lines ) {
        my($k, $v) = split m{[:]}xms, $line, 2;
        $_ = __PACKAGE__->trim( $_ ) for $k, $v;
        $k =~ s{ \A ["']    }{}xms;
        $k =~ s{    ["'] \z }{}xms;
        $k =~ s{    [\s\-]  }{_}xmsg;
        $v =~ s{    [.]  \z }{}xms;
        $rv{lc $k} = $v;
    }

    $rv{page_size}   = $page_size;

    $rv{memory_free} = (  $rv{pages_speculative}
                        + $rv{pages_free}
                        )
                        * $rv{page_size};

    $rv{memory_used} = (  $rv{pages_wired_down}
                        + $rv{pages_inactive}
                        + $rv{pages_active}
                        )
                        * $rv{page_size};
    return %rv;
}

sub system_profiler {
    # SPSoftwareDataType -> os version. user
    # SPHardwareDataType -> cpu
    # SPMemoryDataType   -> ram
    my(@types) = @_;

    my $success;
    my($out, $error) = capture {
        $success = ! system '/usr/sbin/system_profiler' => '-xml', (@types ? @types : ())
    };

    croak "system_profiler(@types) failed!"                      if ! $success;
    croak "system_profiler(@types) did not generate any output!" if ! $out;

    my $raw = plist( $out );

    my %rv;
    foreach my $e ( @{ $raw } ) {
        next if ref $e ne 'HASH' || ! (keys %{ $e });
        my $key     = delete $e->{_dataType};
        my $value   = delete $e->{_items};
        $rv{ $key } = @{ $value } == 1 ? $value->[0] : $value;
    }

    return @types && @types == 1 ? values %rv : %rv;
}

sub sw_vers {
    my $success;
    my($out, $error) = capture {
        $success = ! system '/usr/bin/sw_vers';
    };

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

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

    return map { split m{:\s+?}xms, $_ }
                 split m{\n}xms, $out;
}

sub fsysctl {
    my $key = shift || croak 'Key is missing';
    my $rv  = _sysctl( $key );
    my $val = $rv->{bogus} ? croak "sysctl: $key is not defined"
            : $rv->{error} ? croak "Error fetching $key: $rv->{error}"
            :                $rv->{value}
            ;
    return $val;
}

sub nsysctl {
    my $key = shift || croak 'Key is missing';
    return _sysctl($key)->{value};
}

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

Sys::Info::Driver::OSX

=head1 VERSION

version 0.7963

=head1 SYNOPSIS

    use Sys::Info::Driver::OSX;

=head1 DESCRIPTION

This is the main module in the C<OSX> driver collection.

=head1 NAME

Sys::Info::Driver::OSX - OSX driver for Sys::Info

=head1 METHODS

None.

=head1 FUNCTIONS

=head2 fsysctl

f(atal)sysctl().

=head2 nsysctl

n(ormal)sysctl.

=head2 powermetrics