############################################################
#
# $Id: DMIDecode.pm 1004 2007-03-11 12:43:25Z nicolaw $
# Parse::DMIDecode - Interface to SMBIOS using dmidecode
#
# Copyright 2006,2007 Nicola Worthington
#
# Licensed under the Apache License, Version 2.0 (the "License");
# you may not use this file except in compliance with the License.
# You may obtain a copy of the License at
#
# http://www.apache.org/licenses/LICENSE-2.0
#
# Unless required by applicable law or agreed to in writing, software
# distributed under the License is distributed on an "AS IS" BASIS,
# WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
# See the License for the specific language governing permissions and
# limitations under the License.
#
############################################################
package Parse::DMIDecode;
# vim:ts=4:sw=4:tw=78
use strict;
#use Scalar::Util qw(refaddr);
use Parse::DMIDecode::Handle;
use Parse::DMIDecode::Constants qw(@TYPES %GROUPS);
use Carp qw(croak cluck carp);
use vars qw($VERSION $DEBUG);
$VERSION = '0.03' || sprintf('%d', q$Revision: 1004 $ =~ /(\d+)/g);
$DEBUG ||= $ENV{DEBUG} ? 1 : 0;
my $objstore = {};
#
# Methods
#
sub new {
ref(my $class = shift) && croak 'Class name required';
croak 'Odd number of elements passed when even was expected' if @_ % 2;
my $self = bless \(my $dummy), $class;
$objstore->{_refaddr($self)} = {@_};
my $stor = $objstore->{_refaddr($self)};
$stor->{commands} = [qw(dmidecode)];
my $validkeys = join('|','nowarnings',@{$stor->{commands}});
my @invalidkeys = grep(!/^$validkeys$/,grep($_ ne 'commands',keys %{$stor}));
delete $stor->{$_} for @invalidkeys;
cluck('Unrecognised parameters passed: '.join(', ',@invalidkeys))
if @invalidkeys && $^W;
for my $command (@{$stor->{commands}}) {
croak "Command $command '$stor->{$command}'; file not found"
if defined $stor->{$command} && !-f $stor->{$command};
}
DUMP('$self',$self);
DUMP('$stor',$stor);
return $self;
}
sub probe {
my $self = shift;
croak 'Not called as a method by parent object'
unless ref $self && UNIVERSAL::isa($self, __PACKAGE__);
my $stor = $objstore->{_refaddr($self)};
eval {
if (!defined $stor->{dmidecode}) {
require File::Which;
for my $command (@{$stor->{commands}}) {
$stor->{$command} = File::Which::which($command)
if !defined $stor->{$command};
}
}
};
croak $@ if $@;
my ($cmd) = $stor->{dmidecode} =~ /^([\/\.\_\-a-zA-Z0-9 ]+)$/;
TRACE($cmd);
croak "dmidecode command '$cmd' does not exist; bum!" if !-f $cmd;
my $fh;
local %ENV = %ENV;
delete @ENV{qw(IFS CDPATH ENV BASH_ENV PATH)};
open($fh,'-|',$cmd) || croak "Unable to open file handle for command '$cmd': $!";
while (local $_ = <$fh>) {
$stor->{raw} .= $_;
}
close($fh) || carp "Unable to close file handle for command '$cmd': $!";
return $self->parse($stor->{raw});
}
sub parse {
my $self = shift;
croak 'Not called as a method by parent object'
unless ref $self && UNIVERSAL::isa($self, __PACKAGE__);
my $stor = $objstore->{_refaddr($self)};
my %data = (handles => []);
my @lines;
for (@_) {
push @lines, split(/\n/,$_);
}
my $i = 0;
for (; $i < @lines; $i++) {
local $_ = $lines[$i];
if (/^Handle [0-9A-Fx]+/) {
last;
} elsif (/^SYSID present\.\s*/) {
# No-op
} elsif (/^# dmidecode ([\d\.]+)\s*$/) {
$data{dmidecode} = $1;
} elsif (/^(\d+) structures occupying (\d+) bytes?\.\s*$/) {
$data{structures} = $1;
$data{bytes} = $2;
} elsif (/^DMI ([\d\.]+) present\.?\s*$/) {
$data{dmi} = $1;
} elsif (/^SMBIOS ([\d\.]+) present\.?\s*$/) {
$data{smbios} = $1;
} elsif (/^(?:DMI )?[Tt]able at ([0-9A-Fx]+)\.?\s*$/) {
$data{location} = $1;
}
}
for (qw(dmidecode structures bytes dmi smbios location)) {
$data{$_} = undef if !exists $data{$_};
}
my $raw_handle_data = '';
for (; $i < @lines; $i++) {
if ($lines[$i] =~ /^Handle [0-9A-Fx]+/) {
push @{$data{handles}}, Parse::DMIDecode::Handle->new(
raw => $raw_handle_data,
nowarnings => $stor->{nowarnings}
) if $raw_handle_data;
$raw_handle_data = "$lines[$i]\n";
} else {
$raw_handle_data .= "$lines[$i]\n";
}
}
push @{$data{handles}}, Parse::DMIDecode::Handle->new(
raw => $raw_handle_data,
nowarnings => $stor->{nowarnings}
) if $raw_handle_data;
carp sprintf("Only parsed %d structures when %d were expected",
scalar(@{$data{handles}}), $data{structures}
) if scalar(@{$data{handles}}) < $data{structures};
$stor->{parsed} = \%data;
DUMP('$stor->{parsed}',$stor->{parsed});
return $stor->{parsed}->{structures};
}
sub get_handles {
my $self = shift;
croak 'Not called as a method by parent object'
unless ref $self && UNIVERSAL::isa($self, __PACKAGE__);
croak 'Odd number of elements passed when even was expected' if @_ % 2;
my %param = @_;
my $stor = $objstore->{_refaddr($self)};
my @handles;
my $getall = !keys(%param);
for my $handle (@{$stor->{parsed}->{handles}}) {
if ($getall ||
(defined $param{address} && $handle->address eq $param{address}) ||
(defined $param{dmitype} && $handle->dmitype == $param{dmitype}) ||
(defined $param{group} && defined $GROUPS{$param{group}} &&
grep($_ == $handle->dmitype,@{$GROUPS{$param{group}}}))
) {
push @handles, $handle;
}
}
return @handles;
}
sub structures {
my $self = shift;
croak 'Not called as a method by parent object'
unless ref $self && UNIVERSAL::isa($self, __PACKAGE__);
return $objstore->{_refaddr($self)}->{parsed}->{structures};
}
sub table_location {
my $self = shift;
croak 'Not called as a method by parent object'
unless ref $self && UNIVERSAL::isa($self, __PACKAGE__);
return $objstore->{_refaddr($self)}->{parsed}->{location};
}
sub smbios_version {
my $self = shift;
croak 'Not called as a method by parent object'
unless ref $self && UNIVERSAL::isa($self, __PACKAGE__);
return $objstore->{_refaddr($self)}->{parsed}->{smbios};
}
sub dmidecode_version {
my $self = shift;
croak 'Not called as a method by parent object'
unless ref $self && UNIVERSAL::isa($self, __PACKAGE__);
return $objstore->{_refaddr($self)}->{parsed}->{dmidecode};
}
sub handle_addresses {
my $self = shift;
croak 'Not called as a method by parent object'
unless ref $self && UNIVERSAL::isa($self, __PACKAGE__);
return map { $_->handle }
@{$objstore->{_refaddr($self)}->{parsed}->{handles}};
}
sub keywords {
my $self = shift;
croak 'Not called as a method by parent object'
unless ref $self && UNIVERSAL::isa($self, __PACKAGE__);
my %keywords;
my $stor = $objstore->{_refaddr($self)};
for my $handle (@{$stor->{parsed}->{handles}}) {
for my $keyword ($handle->keywords) {
$keywords{$keyword} = 1;
}
}
return sort(keys(%keywords));
}
sub keyword {
my $self = shift;
croak 'Not called as a method by parent object'
unless ref $self && UNIVERSAL::isa($self, __PACKAGE__);
croak sprintf('%s elements passed when one was expected',
(@_ > 1 ? 'Multiple' : 'No')) if @_ != 1;
my $stor = $objstore->{_refaddr($self)};
for my $handle (@{$stor->{parsed}->{handles}}) {
if (grep($_ eq $_[0],$handle->keywords)) {
return $handle->keyword($_[0]);
}
}
}
no warnings 'redefine';
sub UNIVERSAL::a_sub_not_likely_to_be_here { ref($_[0]) }
use warnings 'redefine';
sub _blessed ($) {
local($@, $SIG{__DIE__}, $SIG{__WARN__});
return length(ref($_[0]))
? eval { $_[0]->a_sub_not_likely_to_be_here }
: undef
}
sub _refaddr($) {
my $pkg = ref($_[0]) or return undef;
if (_blessed($_[0])) {
bless $_[0], 'Scalar::Util::Fake';
} else {
$pkg = undef;
}
"$_[0]" =~ /0x(\w+)/;
my $i = do { local $^W; hex $1 };
bless $_[0], $pkg if defined $pkg;
return $i;
}
sub DESTROY {
my $self = shift;
delete $objstore->{_refaddr($self)};
}
sub TRACE {
return unless $DEBUG;
carp(shift());
}
sub DUMP {
return unless $DEBUG;
eval {
require Data::Dumper;
local $Data::Dumper::Indent = 2;
local $Data::Dumper::Terse = 1;
carp(shift().': '.Data::Dumper::Dumper(shift()));
}
}
1;
=pod
=head1 NAME
Parse::DMIDecode - Interface to SMBIOS using dmidecode
=head1 SYNOPSIS
use strict;
use Parse::DMIDecode ();
my $decoder = new Parse::DMIDecode;
$decoder->probe; # Actively probe using dmidecode
# Manually supply your own dmidecode output to be parsed
# $decoder->parse(qx(sudo /usr/sbin/dmidecode));
printf("System: %s, %s",
$decoder->keyword("system-manufacturer"),
$decoder->keyword("system-product-name"),
);
=head1 DESCRIPTION
This module provides an OO interface to SMBIOS information through
the I<dmidecode> command which is known to work under a number of
Linux, BSD and BeOS variants.
=head1 METHODS
=head2 new
my $decoder = Parse::DMIDecode->new(
dmidecode => "/usr/sbin/dmidecode",
nowarnings => 1,
);
This is the constructor method to create a Parse::DMIDeocde
object. It accepts two optional arguments; C<dmidecode> and
C<nowarnings>.
The C<dmidecode> argument specifies the full path and filename
of the I<dmodecode> command that should used by the C<probe>
method.
The C<nowarnings> argument instructs Parse::DMIDecode not to
emit any parser warnings.
=head2 probe
$decoder->probe;
This method executes an active probe to gather information using the
I<dmidecode> command. It does not accept any arguments.
=head2 parse
my $raw = qx(sudo /usr/sbin/dmidecode);
$decoder->prase($raw);
This method is a passive alternative to the C<probe> method. It
accepts a single string argument which should contain output from
the I<dmidecode> command, which it will parse.
=head2 keyword
my $serial_number = $decoder->keyword("system-serial-number");
=head2 keywords
my @keywords = $decoder->keywords;
my @bios_keywords = $decoder->keywords("bios");
for my $keyword (@bios_keywords) {
printf("%s => %s\n",
$keyword,
$decoder->keyword($keyword)
);
}
=head2 handle_addresses
my @addresses = $decoder->handle_addresses;
=head2 get_handles
use Parse::DMIDecode::Constants qw(@TYPES);
# Available groups to query: bios, system, baseboard,
# chassis, processor, memory, cache, connector, slot
for my $handle ($decoder->get_handles( group => "memory" )) {
printf(">> Found handle at %s (%s):\n%s\n",
$handle->address,
$TYPES[$handle->dmitype],
$handle->raw
);
}
See L<Parse::DMIDecode::Handle> for accessor method documentation
for handle objects.
=head2 smbios_version
my $smbios_version = $decoder->smbios_version;
Returns the SMBIOS version number.
=head2 dmidecode_version
my $dmidecode_version = $decoder->dmidecode_version;
Returns the version number of the copy of I<dmidecode> that was used
to create the source data that was parsed. This value may not be available
when using older versions of I<dmidecode>.
=head2 table_location
my $memory_address = $decoder->table_location;
=head2 structures
my $total_structures = $decoder->structures;
=head1 SEE ALSO
L<Parse::DMIDecode::Handle>,
L<Parse::DMIDecode::Constants>,
L<Parse::DMIDecode::Examples>,
examples/*.pl,
L<http://search.cpan.org/src/NICOLAW/Parse-DMIDecode-0.03/examples/>,
L<http://www.nongnu.org/dmidecode/>,
L<http://linux.dell.com/libsmbios/>,
L<http://sourceforge.net/projects/x86info/>,
L<http://www.dmtf.org/standards/smbios>,
L<biosdecode(8)>, L<dmidecode(8)>, L<vpddecode(8)>
=head1 VERSION
$Id: DMIDecode.pm 1004 2007-03-11 12:43:25Z nicolaw $
=head1 AUTHOR
Nicola Worthington <nicolaw@cpan.org>
L<http://perlgirl.org.uk>
If you like this software, why not show your appreciation by sending the
author something nice from her
L<Amazon wishlist|http://www.amazon.co.uk/gp/registry/1VZXC59ESWYK0?sort=priority>?
( http://www.amazon.co.uk/gp/registry/1VZXC59ESWYK0?sort=priority )
=head1 COPYRIGHT
Copyright 2006,2007 Nicola Worthington.
This software is licensed under The Apache Software License, Version 2.0.
L<http://www.apache.org/licenses/LICENSE-2.0>
=cut
__END__