#!/usr/bin/perl # batmon.pl - sjb (ottaky@ottaky.com) - 18/07/02 - dead simple battery monitor for ACPI (written for Vaio U1, should work for others) # # The constant ACPI points to /proc/acpi - you may need to change this if your kernel puts it somewhere else use constant ACPI => '/proc/acpi'; use constant BATT => ACPI.'/battery/BAT1'; use constant ACAD => ACPI.'/ac_adapter/ACAD'; use constant TEMP => ACPI.'/thermal_zone/ATF0'; my $battinfo = &getACPIInfo(BATT.'/info') || die "Couldn't get battery info"; my $battstate = &getACPIInfo(BATT.'/state') || die "Couldn't get battery status"; my $acadstate = &getACPIInfo(ACAD.'/state') || die "Couldn't get ac-adapter status"; my $tempstate = &getACPIInfo(TEMP.'/temperature') || die "Couldn't get temperature status"; print "CPU temperature is ".(($$tempstate{'temperature'}) ? $$tempstate{'temperature'}.' C' : 'unknown')."\n"; die "No battery present.\n" if ($$battinfo{'present'} eq 'no'); print "AC Adapter is ".$$acadstate{'state'}."\n". "Battery is ".$$battstate{'charging state'}." at $$battstate{'present rate'} mW\n". "Battery is ". (sprintf "%.2f", (($$battstate{'remaining capacity'} / $$battinfo{'last full capacity'}) * 100)). "% charged at $$battstate{'remaining capacity'} mWh\n"; if ($$acadstate{'state'} eq 'off-line' && $$battstate{'charging state'} eq 'discharging' && $$battstate{'present rate'}) { print "Time to run is approximately ". (int(($$battstate{'remaining capacity'} / $$battstate{'present rate'}) * 60)). " minutes\n"; } elsif ($$acadstate{'state'} eq 'on-line' && $$battstate{'charging state'} eq 'charging' && $$battstate{'present rate'}) { print "Time to full charge is approximately ". (int((($$battinfo{'last full capacity'} - $$battstate{'remaining capacity'}) / $$battstate{'present rate'}) * 60)). " minutes\n"; } elsif ($$battstate{'charging state'} eq 'charging' && $$battstate{'present rate'} == 0) { print "Battery is fully charged\n"; } else { print "Your battery does not appear to be charging or discharging??\n"; } sub getACPIInfo ($) { my ($interface) = @_; my %info; if (-e $interface) { if (open (INTERFACE, $interface)) { while () { my ($label,$value) = (m/^([^:]+):\s+(.+)$/); $value =~ s/\D//g if ($value =~ /^\d/); $info{$label} = $value; } close (INTERFACE); return (\%info); } } return undef; }