| Chess | Tools | Data | Blog | Poetry | Why? | Wiki | Admin | Logout |

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


Advertisement