#!/usr/bin/perl
use XML::Simple;
use LWP::Simple;
use LWP::UserAgent;
use IO::Socket;
use Data::Dumper;
# Projects To Provide Data For
# 0 means disable, 1 means enable
################
$get_boinc = 1;
$boinc_usefile = 0; #Get data from the local BOINC install (may not work for non-SETI WUs; 1st CPU's work only)
$boinc_useremote = 1; #Get data from clients via BOINC RPC Calls (this should work with all BOINC projects; all running WUs)
$boinc_useweb_seti = 1; #Get SETI@Home user data from [url]http://www.boincstats.com[/url]
$boinc_useweb_boinc = 0; #Get overall BOINC userdata from [url]http://www.boincstats.com[/url]
$get_classic = 0;
$classic_usefile = 0; #Not implemented yet!
$classic_useweb = 1; #Get data from [url]http://setiathome.berkeley.edu[/url]
# BOINC Setup
# If you're in windows, make sure to separate directories with "\\" instead of "\".
################
$boinc_home = "c:\\program files\\boinc";
@remote_hosts = ("Goddess", "CRACKERJACK", "Nacho", "Silversurfer");
@remote_ports = (31416, 31416, 31416, 31416);
$seti_id = 15576;
$cross_platform_id = "e9827f3ec722cd9bfe38e68b17b6c1f8";
# Classic Setup
################
$classic_home = "c:\\program files\\seti\@home";
$classic_email = "someone\@juno.com";
# Perl Script Setup
################
$invisible = "333333";
@time = localtime;
$time[5] += 1900;
$time[4]++;
#[url]http://www.perldoc.com/perl5.6/pod/...-Perl-Functions[/url]
$time_str = sprintf("%02d/%02d/%04d at %02d:%02d.",$time[4],$time[3],$time[5],$time[2],$time[1]);
################################################################################
##
## Variables which can be used in the signiture:
##
## BOINC_USEFILE:
## $seti_progress Fraction of the way through the current WU (0 through 1)
## $wu_name Name of the current WU
## $seti_credit_total Total credit for the SETI@Home project
## $seti_credit_recent RAC for the SETI@Home project
##
##
## BOINC_USEREMOTE:
## * $blah[x] = $blah for the Xth remote client successfully contacted
## * $blah[x][0] = The first of (possibly several) values for $blah[x]
## * Only applies to XML elements that would have multiple values (ie: result_name, project_name, etc)
##
## $domain_name[x] Name of the computer
## $ip_addr[x] IP Address of the computer
## $p_ncpus[x] Number of CPUs (logical, not physical) seen by BOINC
## $p_model[x] Model String of the CPU (ie: "Mobile Pentium 4 2.80GHz")
## $p_vendor[x] Vendor String of the CPU (ie: "Intel")
## $project_name[x][y] Project(s) signed up for at the location (ie: $project_name[0][0]="SETI", $project_name[0][1]="LHC", etc)
## $total_credit[x][y] Total credit for the Yth project (see $project_name[x][y]) at the location
## $recent_credit[x][y] RAC for the Yth project (see $project_name[x][y]) at the location
## $result_name[x][y] Name of the WU(s) currently being processed (Y>0 only used on systems with p_ncpus>=2)
## $result_url[x][y] Project URL of the WU(s) currently being processed (Y>0... you know the drill :D)
## $result_project[x][y] Project Name of the WU(s) currently being processed (Y>0........)
## $fraction_done[x][y] Fraction of the way through the current WU(s) being processed (Y>0 only used on systems with p_ncpus>=2)
## $cpu_time[x][y] CPU time in seconds spent on the current WU(s) being processed (Y>0 only used on systems with p_ncpus>=2)
##
##
## BOINC_USEWEB_SETI:
## $seti_user SETI@Home username
## $seti_total_credit Total credit for the SETI@Home project (should be same as $seti_credit_total)
## $seti_recent_credit RAC for the SETI@Home project (should be the same as $seti_credit_recent)
## $seti_hostcount Number of hosts running the SETI@Home project
## $seti_overall_rank Worldwide rank within SETI@Home
## $seti_percentile Percentile rank within SETI@Home ("Accumulated more Credit than % of all users")
## $seti_team_rank Team rank for SETI@Home
##
##
## BOINC_USEWEB_BOINC:
## $boinc_user BOINC username
## $boinc_total_credit Total credit (among ALL projects) for BOINC
## $boinc_credit_recent RAC for (among ALL projects) for BOINC
## $boinc_overall_rank Worldwide rank among ALL BOINC users
## $boinc_percentile Percentile rank within ALL of BOINC
## $boinc_sah_total_credit Total credit crunched for the SETI@Home project
## $boinc_sah_percentage Percentage of total credit crunched for SETI@Home
## $boinc_pah_total_credit Total credit crunched for the Predictor@Home project
## $boinc_pah_percentage Percentage of total credit crunched for Predictor@Home
## $boinc_cpdn_total_credit Total credit crunched for the ClimatePrediction.net project
## $boinc_cpdn_percentage Percentage of total credit crunched for ClimatePrediction.net
## $boinc_lhc_total_credit Total credit crunched for the LHC@Home project
## $boinc_lhc_percentage Percentage of total credit crunched for LHC@Home
## $boinc_pirates_total_credit Total credit crunched for the Pirates@Home project
## $boinc_pirates_percentage Percentage of total credit crunched for Pirates@Home
## $boinc_eah_total_credit Total credit crunched for the Einstein@Home project
## $boinc_eah_percentage Percentage of total credit crunched for Einstein@Home
##
##
## CLASSIC_USEWEB:
## $cl_name Classic username
## $cl_num_results Results returned
## $cl_cpu_time Total CPU time
## $cl_avg_time Average CPU time
## $cl_daily_results Results / day
## $cl_last_result Time last WU was recieved
## $cl_reg_date Date registered with SETI@Home Classic
## $cl_user_time Total time you have been a registered user
## $cl_rank Classic worldwide rank
## $cl_rank_same Number of members with the same rank as you
## $cl_top_percent Top percentage of users you are in (100.0 - $cl_top_frac = Crunched more than x% of users)
##
if ($get_boinc) { #Get BOINC data
if ($boinc_usefile) { #Get BOINC data from the local instalation
################################################
# Get data from the local BOINC instalation ##
################################################
# SETI Client File Locations
################
$wu = "$boinc_home/slots/0/work_unit.sah";
$state = "$boinc_home/slots/0/state.sah";
$c_state = "$boinc_home/client_state.xml";
#windows-specific stuff
if ($^O =~ /win/i) {
#change "/" into "\" on windows machines
$wu =~ s/\//\\\\/g;
$state =~ s/\//\\\\/g;
$c_state =~ s/\//\\\\/g;
}
#read client's state into $seti_progress
open BOINC_STATE, "$state";
while (<BOINC_STATE>) {
if (/<prog>[\d\.]*<\/prog>/) {
s/<prog>([\d\.]*)<\/prog>/$1/;
chomp;
$seti_progress = $_;
}
}
close BOINC_STATE;
open BOINC_WU, "$wu";
while (<BOINC_WU>) {
s/<soft_link>\.\.\\\.\.\\projects\\setiathome\.berkeley\.edu\\//;
s/<\/soft_link>//;
chomp;
$wu_name = $_;
}
close BOINC_WU;
$cs_xml = XMLin($c_state);
$seti_credit_total = $cs_xml->{project}->{user_total_credit};
$seti_credit_recent = $cs_xml->{project}->{user_expavg_credit};
}
if ($boinc_useremote) { #Get BOINC data from remote RPC calls
##########################################################
# Get data from the remote locations in @remote_hosts ##
##########################################################
#Cycle through all hosts declared in the array at top
################
$contacted_hosts=0;
for($i=0; $i<@remote_hosts; $i++) {
my $name = $remote_hosts[$i] or die "Missing server name\n";
my $port = $remote_ports[$i] or die "Missing port number\n";
my $socket = IO::Socket::INET->new('PeerAddr' => $name, 'PeerPort' => $port, 'Proto' => 'tcp');
if ($socket) { #ONLY do the following if socket creation sucessful
# Get first 100K of state data from BOINC client
################
print $socket "<get_state/>\n";
$socket->recv($reply,102400);
#print "$reply";
close $socket or die "Can't close socket ($!)\n";
# Remove trailing charachter from string (to make XML compliant)
################
$reply = substr($reply, 0, -1, );
# Push the XML reply onto the array of replys
################
$xml = new XML::Simple keyattr => [];
push(@rpc, $xml->XMLin($reply));
$contacted_hosts += 1;
}
}
# Set up some initial vars into arrays
# Not extremely useful for "foreach" loops, as you will have to use
# the @index array to sucessfully substitute in array values.
################
$host_num = 0;
foreach $host (@rpc) {
$index[$host_num] = $host_num; #index is NOTHING more than a cheap way of letting the predefined vars work with a foreach loop
$domain_name[$host_num] = $host->{host_info}->{domain_name};
$ip_addr[$host_num] = $host->{host_info}->{ip_addr};
$p_ncpus[$host_num] = $host->{host_info}->{p_ncpus};
$p_model[$host_num] = $host->{host_info}->{p_model};
$p_vendor[$host_num] = $host->{host_info}->{p_vendor};
if (ref($host->{project}) eq 'ARRAY') { #If signed up for multiple projects...
$i = 0;
foreach $project (@{$host->{project}}) { #Store each project into it's own array
$project_name[$host_num][$i] = $project->{project_name};
$total_credit[$host_num][$i] = $project->{user_total_credit};
$recent_credit[$host_num][$i] = $project->{user_expavg_credit};
$i = $i + 1;
}
}
else { #Get only the single project's data
$project_name[$host_num][0] = $project->{project_name};
$total_credit[$host_num][0] = $project->{user_total_credit};
$recent_credit[$host_num][0] = $project->{user_expavg_credit};
}
if (ref($host->{result}) eq 'ARRAY') { #If more than one result is on the system...
$i = 0;
foreach $result (@{$host->{result}}) { #Extract the results....
$active = $result->{active_task}->{result_name};
if ($active ne "") { #Looking only for the "active" one.
$result_name[$host_num][$i] = $result->{active_task}->{result_name};
$result_url[$host_num][$i] = $result->{active_task}->{project_master_url};
#Get name of the project the WU is for
# note: this requires making a new XML object for this
# specific RPC so that we can "fold" the tree and find
# the title from what data we are given
###############
$temp_xml = XMLin($reply, keyattr => [ 'master_url' ]);
$result_project[$host_num][$i] = $temp_xml->{project}->{$result_url[$host_num][$i]}->{project_name};
$fraction_done[$host_num][$i] = $result->{active_task}->{fraction_done};
$cpu_time[$host_num][$i] = $result->{active_task}->{current_cpu_time};
$i = $i + 1;
}
}
}
else { #Extract the only result (which should be active...)
$result_name[$host_num][0] = $host->{result}->{active_task}->{result_name};
$fraction_done[$host_num][0] = $host->{result}->{active_task}->{fraction_done};
$cpu_time[$host_num][0] = $host->{result}->{active_task}->{current_cpu_time};
}
$host_num = $host_num + 1;
}
}
if ($boinc_useweb_seti) { #Get BOINC data from [url]http://www.boincstats.com[/url]
##########################################
# Get SETI@Home BOINC stats from web ##
##########################################
$boinc_page = "http://www.boincstats.com/stats/user_graph.php?pr=sah&id=$seti_id";
$local_boinc_cache = "boinc_seti.html";
getstore($boinc_page, $local_boinc_cache);
if (! -e $local_boinc_cache) {
print "get the file, stupid\n";
exit;
}
#extract stats from boinc page
open BC, "$local_boinc_cache";
while(<BC>){
if (/Detailed statistics for<br>/) {
$_ =~ s/"([a-zA-Z][\w\s]*)/$1/;
$seti_user = $1;
} elsif (/<td>Total Credit</) {
<BC>;
$seti_total_credit = <BC>;
chomp($seti_total_credit);
$seti_total_credit =~ s/\s*([\d\.\,]*)<.*/$1/;
} elsif (/Number of hosts/) {
<BC>;
$seti_hostcount = <BC>;
chomp($seti_hostcount);
$seti_hostcount =~ s/\s*(\d*).*/$1/;
} elsif (/World Position/) {
<BC>;
$seti_overall_rank = <BC>;
chomp($seti_overall_rank);
$seti_overall_rank =~ s/\s*([\d,]*).*/$1/;
} elsif (/Recent Average Credit/) {
<BC>;
$seti_recent_credit = <BC>;
chomp($seti_recent_credit);
$seti_recent_credit =~ s/\s*([\d\.\,]*).*/$1/;
} elsif (/than % of all users/) {
$seti_percentile = <BC>;
chomp($seti_percentile);
$seti_percentile =~ s/<td>(\d*.\d*)%.*/$1/;
} elsif (/Position in Team/) {
<BC>;
$seti_team_rank = <BC>;
chomp($seti_team_rank);
$seti_team_rank =~ s/\s*(\d*).*/$1/;
}
}
close BC;
}
if ($boinc_useweb_boinc) { #Get BOINC data from [url]http://www.boincstats.com[/url]
########################################
# Get Overall BOINC stats from web ##
########################################
$boinc_page = "http://www.boincstats.com/stats/boinc_user_graph.php?pr=bo&id=$cross_platform_id";
$local_boinc_cache = "boinc_overall.html";
getstore($boinc_page, $local_boinc_cache);
if (! -e $local_boinc_cache) {
print "get the file, stupid\n";
exit;
}
#extract stats from boinc page
open BC, "$local_boinc_cache";
while(<BC>){
if (/Detailed statistics for<br>/) {
$_ =~ s/"([a-zA-Z][\w\s]*)/$1/;
$boinc_user = $1;
} elsif (/<td>Total Credit</) {
#<BC>;
$boinc_total_credit = <BC>;
chomp($boinc_total_credit);
$boinc_total_credit =~ s/<td>([\d\.\,]*)<.*/$1/;
} elsif (/BOINC World Position/) {
<BC>;
$boinc_overall_rank = <BC>;
chomp($boinc_overall_rank);
$boinc_overall_rank =~ s/\s*([\d,]*).*/$1/;
} elsif (/<td>Recent Average Credit</) {
<BC>;
$boinc_credit_recent = <BC>;
chomp($boinc_credit_recent);
$boinc_credit_recent =~ s/\s*([\d,]*).*/$1/;
} elsif (/than % of all BOINC users/) {
$boinc_percentile = <BC>;
chomp($boinc_percentile);
$boinc_percentile =~ s/<td>(\d*.\d*)%.*/$1/;
} elsif (/SETI\@Home credits/) {
<BC>;
$boinc_sah_total_credit = <BC>;
chomp($boinc_sah_total_credit);
$boinc_sah_total_credit =~ s/\s*([\d\.\,]*)<.*/$1/;
} elsif (/Percentage of credits crunched for SETI\@Home/) {
<BC>;
$boinc_sah_percentage = <BC>;
chomp($boinc_sah_percentage);
$boinc_sah_percentage =~ s/\b(\d*.\d*)%.*/$1/;
$boinc_sah_percentage = trimwhitespace($boinc_sah_percentage);
} elsif (/Predictor\@Home credits/) {
<BC>;
$boinc_pah_total_credit = <BC>;
chomp($boinc_pah_total_credit);
$boinc_pah_total_credit =~ s/\s*([\d\.\,]*)<.*/$1/;
$boinc_pah_total_credit = trimwhitespace($boinc_pah_total_credit);
} elsif (/Percentage of credits crunched for Predictor\@Home/) {
<BC>;
$boinc_pah_percentage = <BC>;
chomp($boinc_pah_percentage);
$boinc_pah_percentage =~ s/\b(\d*.\d*)%.*/$1/;
$boinc_pah_percentage = trimwhitespace($boinc_pah_percentage);
} elsif (/Climate Prediction credits/) {
<BC>;
$boinc_cpdn_total_credit = <BC>;
chomp($boinc_cpdn_total_credit);
$boinc_cpdn_total_credit =~ s/\s*([\d\.\,]*)<.*/$1/;
$boinc_cpdn_total_credit = trimwhitespace($boinc_cpdn_total_credit);
} elsif (/Percentage of credits crunched for Climate Prediction/) {
<BC>;
$boinc_cpdn_percentage = <BC>;
chomp($boinc_cpdn_percentage);
$boinc_cpdn_percentage =~ s/\b(\d*.\d*)%.*/$1/;
$boinc_cpdn_percentage = trimwhitespace($boinc_cpdn_percentage);
} elsif (/LHC\@Home credits/) {
<BC>;
$boinc_lhc_total_credit = <BC>;
chomp($boinc_lhc_total_credit);
$boinc_lhc_total_credit =~ s/\s*([\d\.\,]*)<.*/$1/;
$boinc_lhc_total_credit = trimwhitespace($boinc_lhc_total_credit);
} elsif (/Percentage of credits crunched for LHC\@Home/) {
<BC>;
$boinc_lhc_percentage = <BC>;
chomp($boinc_lhc_percentage);
$boinc_lhc_percentage =~ s/\b(\d*.\d*)%.*/$1/;
$boinc_lhc_percentage = trimwhitespace($boinc_lhc_percentage);
} elsif (/Pirates\@Home credits/) {
<BC>;
$boinc_pirates_total_credit = <BC>;
chomp($boinc_pirates_total_credit);
$boinc_pirates_total_credit =~ s/\s*([\d\.\,]*)<.*/$1/;
$boinc_pirates_total_credit = trimwhitespace($boinc_pirates_total_credit);
} elsif (/Percentage of credits crunched for Pirates\@Home/) {
<BC>;
$boinc_pirates_percentage = <BC>;
chomp($boinc_pirates_percentage);
$boinc_pirates_percentage =~ s/\b(\d*.\d*)%.*/$1/;
$boinc_pirates_percentage = trimwhitespace($boinc_pirates_percentage);
} elsif (/Einstein\@Home credits/) {
<BC>;
$boinc_eah_total_credit = <BC>;
chomp($boinc_eah_total_credit);
$boinc_eah_total_credit =~ s/\s*([\d\.\,]*)<.*/$1/;
$boinc_eah_total_credit = trimwhitespace($boinc_eah_total_credit);
} elsif (/Percentage of credits crunched for Einstein\@Home/) {
<BC>;
$boinc_eah_percentage = <BC>;
chomp($boinc_eah_percentage);
$boinc_eah_percentage =~ s/\b(\d*.\d*)%.*/$1/;
$boinc_eah_percentage = trimwhitespace($boinc_eah_percentage);
}
}
close BC;
}
}
if ($get_classic) { #Get Classic Data
if ($classic_usefile) {
#NOT YET IMPLMENTED!!
}
if ($classic_useweb) {
################################
# Get stats from Berkeley ##
################################
$berk_url = "http://setiathome2.ssl.berkeley.edu/fcgi-bin/fcgi?email=$classic_email&cmd=user_xml";
$berk_url =~ s/@/%40/;
$ua = LWP::UserAgent->new();
$berk_xml = $ua->get( "$berk_url");
#extract info from Berkeley's not-quite XML
$xmld = "";
foreach $line (split /^/, $berk_xml->content) {
$xmld .= $line;
}
#print "XML: $xmld";
$berkeley_xml = new XML::Simple keyattr => [];
$berkeley_xml = XMLin($xmld);
$cl_name = trimwhitespace($berkeley_xml->{userinfo}->{name});
$cl_num_results = trimwhitespace($berkeley_xml->{userinfo}->{numresults});
$cl_cpu_time = trimwhitespace($berkeley_xml->{userinfo}->{cputime});
$cl_avg_time = trimwhitespace($berkeley_xml->{userinfo}->{avecpu});
$cl_daily_results = trimwhitespace($berkeley_xml->{userinfo}->{resultsperday});
$cl_last_result = trimwhitespace($berkeley_xml->{userinfo}->{lastresulttime});
$cl_reg_date = trimwhitespace($berkeley_xml->{userinfo}->{regdate});
$cl_user_time = trimwhitespace($berkeley_xml->{userinfo}->{usertime});
$cl_rank = trimwhitespace($berkeley_xml->{rankinfo}->{rank});
$cl_rank_same = trimwhitespace($berkeley_xml->{rankinfo}->{num_samerank});
$cl_top_percent = toPercent(trimwhitespace($berkeley_xml->{rankinfo}->{top_rankpct}));
}
}
#These are boring examples of how to print out stuff.
#Hopefully, you'll come up with something more interesting. ;)
#print "LOCAL BOINC INFO:\n";
#print "progress is $seti_progress\n";
#print "total credits is $seti_credit\n";
#print "wu name is $wu_name\n";
#if ($boinc_useweb_seti) {
# print "BOINC INFO:\n";
# print "username = $boinc_user\n";
# print "ID = $boinc_id\n";
# print "total credit = $boinc_total_credit\n";
# print "hosts = $boinc_hostcount\n";
# print "overall rank = $boinc_overall_rank\n";
# print "percentile = $boinc_percentile\n";
# print "team rank = $boinc_team_rank\n";
#}
#if ($boinc_useweb_boinc) {
# print "$boinc_user\n";
# print "Total: $boinc_total_credit\n";
# print "Total2: $seti_total_credit\n";
# print "RAC: $boinc_credit_recent\n";
# print "Rank: $boinc_overall_rank\n";
# print "Percentile: $boinc_percentile\n";
# print "SETI Total: $boinc_sah_total_credit\n";
# print "SETI Percentile: $boinc_sah_percentage\n";
# print "PAH Total: $boinc_pah_total_credit\n";
# print "PAH Percentile: $boinc_pah_percentage\n";
# print "CPDN Total: $boinc_cpdn_total_credit\n";
# print "CPDN Percentile: $boinc_cpdn_percentage\n";
# print "LHC Total: $boinc_lhc_total_credit\n";
# print "LHC Percentile: $boinc_lhc_percentage\n";
# print "Pirates Total: $boinc_pirates_total_credit\n";
# print "Pirates Percentile: $boinc_pirates_percentage\n";
# print "Einstein Total: $boinc_eah_total_credit\n";
# print "Einstein Percentile: $boinc_eah_percentage\n";
#}
#if ($classic_useweb) {
# print "CLASSIC INFO:\n";
# print "username is $cl_name\n";
# print "number of results is $cl_num_results\n";
# print "total cpu time donated is $cl_cpu_time\n";
# print "average cpu time is $cl_avg_time\n";
# print "results per day is $cl_daily_results\n";
# print "last result returned on $cl_last_result\n";
# print "registration date: $cl_reg_date\n";
# print "total user time: $cl_user_time\n";
# print "overall rank is $cl_rank\n";
# print "$cl_rank_same members have the same rank as you\n";
# print "you are in the top $cl_top_percent% of all SETI@Home users)";
#}
$crunch_start = "ff00ff";
$crunch_end = "00ff00";
$crunch_str = color_string($crunch_start,$crunch_end,"Crunching for Overclockers.com!");
#99% means you're in the top 1%, so put that in $top_pct
$top_pct = sprintf("%.2f",100.0 - $seti_percentile);
$rank = $seti_overall_rank;
$boinc_total_credit =~ s/,//g;
$credits = sprintf("%.0f",$seti_total_credit);
##################################
#This is where stuff is printed.##
##################################
print "\[b\]$crunch_str\[\/b\]\n";
print "\[size=1\]Team Rank: \[b\]$seti_team_rank" . "th\[\/b\]\[color=#$invisible\]________________\[\/color\]\[b\]$seti_total_credit\[\/b\] Total SETI@Home Credit\n";
print "World Rank: \[b\]$seti_overall_rank" . "th\[\/b\]\[color=#$invisible\]___________________\[\/color\]\[b\]$seti_recent_credit\[\/b\] Recent Average Credit\n";
print "\n";
print "Current Work As Of $time_str \[\/size\]\n";
for ($host = 0; $host < $contacted_hosts; $host++) { #Go through all this code for every host that we managed to connect to via RPC
$line = "";
$line .= "\[FONT=Courier New\] ";
$line .= progbar($fraction_done[$host][0], $fraction_done[$host][1]);
if ($p_ncpus[$host]==1) {$line .= "\[color=#$invisible\]______\[\/color\]";}
$line .= " $domain_name[$host]";
#Color the project depending on if it's a SETI@Home WU or not...
###############
if ($result_project[$host][0] eq "SETI@Home") { #If a SETI@Home WU....
$project = "\[color=PaleTurquoise\]" . $result_project[$host][0] . "\[\/color\]";
}
else { #If not a SETI@Home WU (LHC, CPDN, Predictor, etc)...
$project = "\[color=RoyalBlue\]" . $result_project[$host][0] . "\[\/color\]";
}
$line .= " $project";
if ($result_project[$host][1] ne "") {
if ($result_project[$host][1] eq "SETI@Home") { #If a SETI@Home WU....
$project = "\[color=PaleTurquoise\]" . $result_project[$host][1] . "\[\/color\]";
}
else { #If not a SETI@Home WU (LHC, CPDN, Predictor, etc)...
$project = "\[color=RoyalBlue\]" . $result_project[$host][1] . "\[\/color\]";
}
$line .= " \/ $project";
}
#Colorize / Trim CPU data
# note: aparently some chips have the actual CPU info
# stored in the p_vendor space instead of the p_model
# space. This if statement sees which is longer, and
# sets CPU to that (this assumes the CPU info will
# take more room)
################
if ($p_model[$host] =~ /AMD/i | $p_vendor[$host] =~ /AMD/i) {
$cpu = "\[color=Lime\]";
}
elsif ($p_model[$host] =~ /Intel/i | $p_vendor[$host] =~ /Intel/i) {
$cpu = "\[color=DeepSkyBlue\]";
}
else {
$cpu = "\[color=White\]";
}
if ( length(stripcpu($p_model[$host])) > length(stripcpu($p_vendor[$host])) ) {
$cpu .= stripcpu($p_model[$host]);
}else {
$cpu .= stripcpu($p_vendor[$host]);
}
$cpu .= "\[\/color\]";
$line .= " ($cpu) \[\/FONT\] \n";
print "$line";
}
#Given a starting color, an ending color, a total number of steps, the
#current step and an optional error, return the color that corresponds
#to that step in a gradient.
sub color_grad
{
$start_rgb = shift; #"ff00ff"
$end_rgb = shift; #"00ff00"
$last_step = shift; #"36"
$curr_step = shift; #"12"
#error is random variation, in decimal shades
$error = shift;
$periods = shift;
$fun = shift;
return color_grad_fun($start_rgb,$end_rgb,$curr_step/$last_step,$error,$periods,$fun);
}
sub color_grad_fun
{
my $start_rgb = shift; #"ff00ff"
my $end_rgb = shift; #"00ff00"
my $curr_step = shift; #floating pt number, modded between 0 and 1. inclusive
#OPTIONAL ARG: error is random variation, in decimal shades
my $error = shift;
$error = 0 if (! defined $error);
#OPTIONAL ARG: how many times to cycle through the above function
my $periods = shift;
$periods = 1 if (! defined $periods);
#OPTIONAL ARG: function with a period of 1 and a range 0-1 to determine color distribution
my $fun = shift;
#This function has the same behavior as the previous implementation.
$fun = sub {my $x = shift; return ((255*$x % 255)/255);} if (!defined $fun);
$error /= 255;
for $curr (0,1,2) {
$min = hex(substr($start_rgb,$curr*2,2)) / 255;
$max = hex(substr($end_rgb,$curr*2,2)) / 255;
$range = $max - $min;
$funval = &$fun($curr_step*$periods);
#print "max is $max, min is $min, range is $range, step is $curr_step,";
$color[$curr] = ($min + $range*$funval);
if ($error == 0) {
$my_error = 0;
} else {
$my_error = (rand 2*$error) - $error;
}
while (($color[$curr]+$my_error) < 0 || ($color[$curr]+$my_error) > 1) {
$my_error = ((rand 2*$error) - $error);
}
#print "using error of $my_error, max is $error\n";
#$norml = $color[$curr]*255;
#print "normal color is $norml, ";
$color[$curr] += $my_error;
$color[$curr] *= 255;
#$color[$curr] = sprintf("%.0f",)
#print "color is $color[$curr]\n";
}
return sprintf("%02x%02x%02x",$color[0],$color[1],$color[2]);
}
sub color_string
{
$start_rgb = shift;
$end_rgb = shift;
$string = shift;
$error = shift;
#print "COLOR STRING: passed $string\n";
$error = 0 if (! defined $error);
#ugly bug if this isn't declared my
my $color_string;
$str_len = length $string;
$i=0;
foreach $char (split //, $string) {
$fstr_color=color_grad($start_rgb,$end_rgb,$str_len,$i++,$error);
#vb3 seems to treat individually colored spaces an non-printable
if ($char eq " ") {
$color_string .= "\[color\=\#$invisible\].\[\/color\]";
} else {
$color_string .= "\[color\=\#$fstr_color\]$char\[\/color\]";
}
}
#print "COLOR STRING: returning $color_string\n";
return $color_string;
}
# Remove whitespace from the start and end of the string
sub trimwhitespace($)
{
my $string = shift;
$string =~ s/^\s+//;
$string =~ s/\s+$//;
return $string;
}
sub stripcpu($) {
$string = shift;
$string =~ s/Intel//ig;
$string =~ s/AMD//ig;
$string =~ s/\(R\)//ig;
$string =~ s/\(tm\)//ig;
$string =~ s/CPU//ig;
$string = trimwhitespace($string);
return $string;
}
sub progbar($) {
#make a pretty progress bar
$cpu1_progress = shift;
$cpu2_progress = shift;
#length of progress bar
$prog_len = 15;
#starting and ending colors for progress bar
$cpu1_start_color = "00ff00";
$cpu1_end_color = "ffffff";
$cpu2_start_color = "ff00ff";
$cpu2_end_color = "000000";
#colors for the percent indicator
$cpu1_pct_begin = "00ff00";
$cpu1_pct_end = "ffffff";
$cpu2_pct_begin = "ff00ff";
$cpu2_pct_end = "000000";
#charachter(s) to use for the percent indicator
$cpu1_prog_char = ">";
$cpu2_prog_char = ">";
#calculate number of filled bars, empty bars, and change progress to %
$cpu1_filled_bars = sprintf("%.0f",($cpu1_progress)*$prog_len);
$cpu2_filled_bars = sprintf("%.0f",($cpu2_progress)*$prog_len);
$cpu1_empty_bars = $prog_len - $cpu1_filled_bars;
$cpu2_empty_bars = $prog_len - $cpu2_filled_bars;
$cpu1_pct_prog = sprintf("%.0f",$cpu1_progress*100);
$cpu2_pct_prog = sprintf("%.0f",$cpu2_progress*100);
#print "$cpu1_pct_prog% progress(1) \/ $cpu2_pct_prog% progress(2)\n";
#print "$cpu1_filled_bars chars(1) \/ $cpu2_filled_bars chars(2)\n";
#print "$cpu1_empty_bars unfilled(1) \/ $cpu2_empty_bars unfilled(2)\n";
$prog_bar = "{";
if ($cpu1_pct_prog <= $cpu2_pct_prog) {
$prog_bar .= "\[b\]";
for($i=0; $i < $cpu1_filled_bars; $i++) {
$color=color_grad($cpu1_start_color,$cpu1_end_color,$prog_len, $i);
$prog_bar .= "\[color=#$color\]$cpu1_prog_char\[\/color\]";
}
$prog_bar .= "\[\/b\]";
for($i=$i; $i < $cpu2_filled_bars; $i++) {
$color=color_grad($cpu2_start_color,$cpu2_end_color,$prog_len, $i);
$prog_bar .= "\[color=#$color\]$cpu2_prog_char\[\/color\]";
}
$prog_bar .= "\[color=#$invisible\]";
$prog_bar .= "_" x $cpu2_empty_bars;
$prog_bar .= "\[\/color\]";
$prog_bar .= "}";
}
else {
$prog_bar .= "\[b\]";
for($i=0; $i < $cpu2_filled_bars; $i++) {
$color=color_grad($cpu2_start_color,$cpu2_end_color,$prog_len, $i);
$prog_bar .= "\[color=#$color\]$cpu2_prog_char\[\/color\]";
}
$prog_bar .= "\[\/b\]";
for($i=$i; $i < $cpu1_filled_bars; $i++) {
$color=color_grad($cpu1_start_color,$cpu1_end_color,$prog_len, $i);
$prog_bar .= "\[color=#$color\]$cpu1_prog_char\[\/color\]";
}
$prog_bar .= "\[color=#$invisible\]";
$prog_bar .= "_" x $cpu1_empty_bars;
$prog_bar .= "\[\/color\]";
$prog_bar .= "}";
}
#now $prog_bar looks like "{****___}" but with color tags
$cpu1_pct_len = length $cpu1_pct_prog;
$cpu2_pct_len = length $cpu2_pct_prog;
$spc_len = 2 - $pct_len;
$spc = "_" x $spc_len;
$prog_bar =~ s/$/\[color=#$invisible\]$spc\[\/color\]/;
$pct_color = color_grad($cpu1_pct_begin,$cpu1_pct_end,100,$cpu1_pct_prog);
$prog_bar =~ s/$/\[color=#$pct_color\]$cpu1_pct_prog\%\[\/color\]/;
if ($cpu2_pct_prog != 0) {
$prog_bar .= " \/ ";
$pct_color = color_grad($cpu2_pct_begin,$cpu2_pct_end,100,$cpu2_pct_prog);
$prog_bar =~ s/$/\[color=#$pct_color\]$cpu2_pct_prog\%\[\/color\]/;
}
#progress bar is done!
#It should look like "{~~~~~~_____} 34%" but will COLOR.
return $prog_bar;
}
sub toPercent($) {
$fraction = shift;
$percent = sprintf("%.2f",$fraction);
}
sub setWidth {
#Pads a string with invisible charachters to the right to
#make it a certian width. If the string is LONGER than
#the passed in width, a substring will be taken to truncate
#it down to the specified width
$string = shift;
$width = shift;
if (length $string > $width) {
$string = substr($string,0,$width);
}
else {
$num_blanks = $width - length $string;
$string .= "\[color=#$invisible\]";
$string .= "_" x $num_blanks;
$string .= "\[\/color\]";
}
return $string;
}
