Download
#!/usr/bin/perl -w
# $Revision: 1.18 $
# $Date: 2006-05-08 16:29:06 $
# Luis Mondesi < lemsx1@gmail.com >
#
# DESCRIPTION: spits to STDOUT basic information about the current system
# USAGE: profile-computer.pl [-H|--html]
# LICENSE: GPL
=pod
=head1 NAME
profile-computer - script for profiling a system on the fly
=head1 DESCRIPTION
This script prints system information to STDOUT. It attempts to use Perl calls using standard modules or POSIX commands if no Perl functions exists
=cut
use strict;
$|++;
use Sys::Hostname qw# hostname #;
use POSIX qw/ uname /;
use File::Spec::Functions qw/ catfile /
; #qw/ splitpath curdir updir catfile catdir abs2rel /;
use Getopt::Long;
Getopt::Long::Configure('bundling');
#$ENV{'PATH'} = "/bin:/usr/local/bin:/opt/bin:/usr/bin:/sbin:/usr/sbin";
# Args:
my $PVERSION = 0;
my $HELP = 0;
my $USAGE = 0;
my $DEBUG = 0;
my $HTML = 0;
my $BBCODE = 0;
my $PCIINFO = 1;
my $revision = '1.18';
=pod
=head1 SYNOPSIS
B<profile-computer> [-v,--version]
[-D,--debug]
[-h,--help]
[-H,--html]
[-B,--bbcode]
[-U,--usage]
[--no-pci]
=head1 OPTIONS
=over 8
=item -v,--version
Prints version and exits
=item -D,--debug
Enables debug mode
=item -h,--help
Prints this help and exits
=item -H,--html
Print HTML compatible strings to STDOUT instead of Plain Text
=item -B,--bbcode
Print BBCODE compatible HTML strings to STDOUT instead of Plain Text. Implies --html
=item -U,--usage
Prints usage information and exits
=back
=cut
# get options
GetOptions(
# flags
'v|version' => \$PVERSION,
'h|help' => \$HELP,
'D|debug' => \$DEBUG,
'B|bbcode' => sub { $BBCODE++; $HTML++; },
'U|usage' => \$USAGE,
'H|html' => \$HTML,
'no-pci' => sub { $PCIINFO = 0 },
);
if ($HELP)
{
use Pod::Text;
my $parser = Pod::Text->new(sentence => 0, width => 78);
$parser->parse_from_file($0, \*STDOUT);
exit 0;
}
if ($USAGE)
{
use Pod::Usage;
pod2usage(1);
exit 0; # never reaches here
}
if ($PVERSION) { print STDOUT ($revision, "
"); exit 0; }
my $br = ($HTML) ? "<br />" : "";
my ($sysname, $nodename, $release, $version, $machine) = POSIX::uname();
my $hostname = hostname();
my $cpuinfo = "";
my $memtotal = "";
my $swaptotal = "";
my $bogomips = 0;
my $totalprocessors = 0;
my @cpu = _slurp("/proc/cpuinfo");
my @mem = _slurp("/proc/meminfo");
my @pci =
($PCIINFO and _which("lspci"))
? split(/
/, qx/\(lspci; lspci -n\) | sort/)
: ();
foreach my $line (@cpu, @mem)
{
if ($line =~ /processor\s*:/i)
{
$totalprocessors += 1;
}
elsif ($line =~ /model\s+name\s*:\s*(.*)/i)
{
$cpuinfo = $1;
}
elsif ($line =~ /bogomips\s*:\s*([0-9]+)/i)
{
$bogomips += $1;
}
elsif ($line =~ /memtotal\s*:\s*([0-9]+\s+[kmobg]+)/i)
{
$memtotal = $1;
}
elsif ($line =~ /swaptotal\s*:\s*([0-9]+\s+[kmobg]+)/i)
{
$swaptotal = $1;
}
}
_print_div();
_print("# profile-computer $revision Luis Mondesi <lemsx1\@gmail.com>
");
_print("# http://lems.kiskeyix.org/toolbox/?f=profile-computer\&d=1
");
_print_div();
_print("Host Name: $hostname
");
_print("System Kernel: $sysname, $release, $version, $machine
");
_print_div();
_print("CPU Info: $cpuinfo
");
_print("Total Processors: $totalprocessors
");
_print("Bogomips total: $bogomips
");
_print_div();
_print("Memory: $memtotal
");
_print("Virtual Memory (swap): $swaptotal
");
if ($PCIINFO)
{
_print_div();
foreach my $line (@pci)
{
#0000:01:00.0 VGA compatible controller: ATI Technologies Inc: Unknown device 4153
$line =~ s#^[[:xdigit:]\:\.]+\s+##g; # remove PCI id
chomp($line);
_print("$line
");
}
}
_print_div();
_print_lsb() if (-r "/etc/lsb-release");
_print_div();
_print("Library: libc6
") if (-e glob("/lib/libc-2.*.so"));
_print("Compiler Version: " . qx#gcc --version|head -1#) if (_which("gcc"));
_print_div();
if (-r "/proc/cmdline")
{
if (open(CMDLINE, "</proc/cmdline"))
{
_print("/proc/cmdline
");
while (<CMDLINE>)
{
_print("$_
");
}
close(CMDLINE);
}
}
if (my $_glrxinfo = _which("fglrxinfo"))
{
_print_div();
my $fglrx_args = (exists($ENV{DISPLAY})) ? " -display $ENV{DISPLAY}" : "";
open(FGLRX, "$_glrxinfo $fglrx_args |")
or warn("Could not execute $_glrxinfo
");
while (<FGLRX>)
{
chomp();
_print("$_
");
}
close(FGLRX);
}
_print_div(); # end
# ----------------------------------#
# helper functions #
# ----------------------------------#
sub _print
{
my $line = shift;
my $b_open = "";
my $b_close = "";
if ($HTML or $BBCODE)
{
$b_open = ($BBCODE) ? "[b]" : "<b>";
$b_close = ($BBCODE) ? "[/b]" : "</b>";
if ($line =~ m/([^\:]+):(.*)/)
{
print "${b_open}${1}${b_close}: ${2}$br
";
}
else
{
$line =~ s/(
|
)//g;
print $line, "<br />
";
}
}
else
{
print $line;
}
}
sub _print_div
{
print STDOUT ("
#", "=" x 78, "#$br
");
}
sub _print_lsb
{
my $b_open = "";
my $b_close = "";
if ($HTML or $BBCODE)
{
$b_open = ($BBCODE) ? "[b]" : "<b>";
$b_close = ($BBCODE) ? "[/b]" : "</b>";
}
# lsb_release -a is too slow. This function is 14% faster.
open(FILE, "</etc/lsb-release") or return "";
while (<FILE>)
{
s/(
|
)//g;
s/DISTRIB_/Distributor /;
s/ELEASE/elease/;
s/ESCRIPTION/escription/;
s/ODENAME/odename/;
s/"//g;
s/=/: /;
if (m/([^\:]+):(.*)/)
{
print "${b_open}${1}${b_close}: ${2}$br
";
}
else
{
$_ =~ s/(
|
)//g;
print $_, "$br
";
}
}
}
# which("binary1"[,"binaryN"])
# TODO return LIST if want array back
sub _which
{
my @_path = split(/:/, $ENV{'PATH'});
foreach my $_exec (@_)
{
foreach my $_path (@_path)
{
my $_full_path = File::Spec->catfile($_path, $_exec);
return $_full_path if (-x $_full_path);
}
}
return undef;
}
sub _slurp
{
my $file = shift;
open(FILE, "<$file") or die($!, "
");
my @_lines = <FILE>;
close(FILE);
return @_lines;
}
=pod
=head1 AUTHORS
Luis Mondesi <lemsx1@gmail.com>
=cut
