File Coverage

blib/lib/Mac/SysProfile.pm

Criterion	Covered	Total	%
statement	12	91	13.1
branch	0	36	0.0
condition	0	26	0.0
subroutine	4	12	33.3
pod	6	7	85.7
total	22	172	12.7

package Mac::SysProfile;

use strict;
use warnings;

use Mac::PropertyList ();
use Scalar::Util      ();

our $VERSION = '0.05';

my %conf = (
    'bin' => 'system_profiler',
    'lst' => '-listDataTypes',
    'sfw' => 'SPSoftwareDataType',
    'sfx' => 'os_overview',
    'osx' => 'os_version',
    'drw' => 'kernel_version',
    'xml' => '-xml',
);

my %types;

sub new { bless {}, shift }

sub types {
    my $pro = shift;
    for (`$conf{bin} $conf{lst}`) {
        next if m/:/;
        chomp;
        $pro->{$_} = undef unless exists $pro->{$_};
        $types{$_} = 1;
    }
    return [ keys %types ];
}

sub gettype {
    my ( $pro, $typ, $fre ) = @_;

    $pro->types() unless exists $types{$typ};

    if ( !exists $types{$typ} ) {
        delete $pro->{$typ};
        return;
    }

    return $pro->{$typ} if $pro->{$typ} && !$fre;

    my $data  = Mac::PropertyList::parse_plist( $pro->xml($typ) );
    my $items = $data->[0]{_items};

    # Workaround for types that have multiples (e.g. SPMemoryDataType)
    if ( defined $items->[0] && exists $items->[0]{'_items'} ) {
        $items = $items->[0]{'_items'};
    }

    my $hdr;
    foreach my $item ( @{$items} ) {
        my $res;

        my $name = '';

        # not used to keep from making the already complex structure arbitrarily more complex
        # would also need done in _structify_val()
        # my $name = delete $item->{'_name'} || '';
        #         if ( ref($name) ) {
        #             $name = $name->value();
        # }

        while ( my ( $key, $value ) = each %{$item} ) {
            my $val = $value->value();
            my $end_val;

            if ( ref($val) ) {
                $end_val = $val->value();
            }
            else {
                $end_val = $val;
            }

            if ($name) {
                $res->{$name}{$key} = _structify_val($end_val);
            }
            else {
                $res->{$key} = _structify_val($end_val);
            }
        }

        push @{ $pro->{$typ} }, $res;
    }

    $pro->{$typ} ||= [];

    return $pro->{$typ};
}

# recursive fixer upper: Storable::dclone() does not do it, Mac::PropertyList::plist_as_perl() does not seem to work-patches welcome!
sub _structify_val {
    my ($val) = @_;
    my $ref = Scalar::Util::reftype($val);
    return $val if !$ref;
    if ( $ref eq 'ARRAY' ) {
        my @arr;
        for my $item ( @{$val} ) {
            push @arr, _structify_val($item);
        }
        return \@arr;
    }
    elsif ( $ref eq 'SCALAR' ) {
        return $val->value();
    }
    elsif ( $ref eq 'HASH' ) {
        my %hsh;
        while ( my ( $k, $v ) = each %{$val} ) {
            $hsh{$k} = _structify_val($v);
        }
        return \%hsh;
    }
    else {
        die "Do not know $ref";
    }
}

sub osx {
    my $pro = shift;
    my $fre = shift || '';
    return $pro->{_osx_version} if $pro->{_osx} && !$fre;
    $pro->gettype( $conf{sfw}, $fre );
    ( $pro->{_osx_version} ) = $pro->{ $conf{sfw} }->{ $conf{sfx} }->{ $conf{osx} } =~ m/\s(\d+(\.\d+)*)\D/;
    return $pro->{_osx_version};
}

sub darwin {
    my $pro = shift;
    my $fre = shift || '';
    return $pro->{_darwin_version} if $pro->{_darwin_version} && !$fre;
    $pro->gettype( $conf{sfw}, $fre );
    ( $pro->{_darwin_version} ) = $pro->{ $conf{sfw} }->{ $conf{sfx} }->{ $conf{drw} } =~ m/\s(\d+(\.\d+)*)\D/;
    return $pro->{_darwin_version};
}

sub state_hashref {
    my $pro = shift;
    my %x   = %{$pro};
    return \%x;
}

sub xml {
    my $pro = shift;
    my $key = shift;
    my $fh  = shift || '';
    my $raw = exists $types{$key} ? `$conf{'bin'} $conf{'xml'} $key` : undef;
    print $fh $raw if ref $fh eq 'GLOB' && defined $raw;
    if ( $fh && !ref $fh ) {
        open XML, ">$fh" or return;
        print XML $raw;
        close XML;
    }
    return $raw;
}

1;

__END__