diff options
| author | Paul Buetow <paul@buetow.org> | 2026-02-13 23:47:59 +0200 |
|---|---|---|
| committer | Paul Buetow <paul@buetow.org> | 2026-02-13 23:47:59 +0200 |
| commit | 39b8ed83ed0e9c30fda39e978b1b2e3ffeaa2288 (patch) | |
| tree | 420bb66055675cf8fc04a23fd64d909ead8e9e8a | |
| parent | 8a2251d1fceaed3c563c4916b6b43b03fd44b7c8 (diff) | |
cleanup
| -rw-r--r-- | AGENTS.md | 1 | ||||
| -rw-r--r-- | fonts/font.png | bin | 14883 -> 0 bytes | |||
| -rw-r--r-- | lib/Loadbars/Config.pm | 110 | ||||
| -rw-r--r-- | lib/Loadbars/Constants.pm | 44 | ||||
| -rw-r--r-- | lib/Loadbars/HelpDispatch.pm | 332 | ||||
| -rw-r--r-- | lib/Loadbars/Main.pm | 1092 | ||||
| -rw-r--r-- | lib/Loadbars/Shared.pm | 67 | ||||
| -rw-r--r-- | lib/Loadbars/Utils.pm | 61 |
8 files changed, 0 insertions, 1707 deletions
@@ -7,7 +7,6 @@ This file helps AI assistants (Cursor, Claude, etc.) work effectively in this re **Loadbars** is a real-time server load monitoring tool. It connects to one or more hosts via SSH (or runs locally) and shows CPU, memory, and network usage as vertical colored bars in an SDL window. It does not record or graph history; it shows current state only (like `top` or `vmstat`). - **Repo:** codeberg.org/snonux/loadbars -- **Language:** Go (primary); legacy Perl code remains in `lib/` for reference. - **Display:** SDL2 (go-sdl2). No in-window text/fonts; all bars are drawn with filled rectangles. User feedback (hotkeys, which interface, etc.) is printed to stdout. ## Tech stack diff --git a/fonts/font.png b/fonts/font.png Binary files differdeleted file mode 100644 index 02e9eb1..0000000 --- a/fonts/font.png +++ /dev/null diff --git a/lib/Loadbars/Config.pm b/lib/Loadbars/Config.pm deleted file mode 100644 index 365d8c6..0000000 --- a/lib/Loadbars/Config.pm +++ /dev/null @@ -1,110 +0,0 @@ -package Loadbars::Config; - -use strict; -use warnings; - -use Loadbars::Utils; -use Loadbars::Shared; - -sub read () { - return unless -f Loadbars::Constants->CONFFILE; - - display_info( - "Reading configuration from " . Loadbars::Constants->CONFFILE ); - open my $conffile, Loadbars::Constants->CONFFILE - or die "$!: " . Loadbars::Constants->CONFFILE . "\n"; - - while (<$conffile>) { - chomp; - s/[\t\s]*?#.*//; - - next unless length; - - my ( $key, $val ) = split '='; - - unless ( defined $val ) { - display_warn("Could not parse config line: $_"); - next; - } - - trim($key); - trim($val); - - if ( not exists $C{$key} ) { - display_warn("There is no such config key: $key, ignoring"); - - } - else { - display_info( -"Setting $key=$val, it might be overwritten by command line params." - ); - $C{$key} = $val; - } - } - - close $conffile; -} - -sub write () { - display_warn( "Overwriting config file " . Loadbars::Constants->CONFFILE ) - if -f Loadbars::Constants->CONFFILE; - - open my $conffile, '>', Loadbars::Constants->CONFFILE or do { - display_warn( "$!: " . Loadbars::Constants->CONFFILE ); - - return undef; - }; - - for ( grep !/title/, keys %C ) { - print $conffile "$_=$C{$_}\n"; - } - - close $conffile; -} - -# Recursuve function -sub get_cluster_hosts ($;$); - -sub get_cluster_hosts ($;$) { - my ( $cluster, $recursion ) = @_; - - unless ( defined $recursion ) { - $recursion = 1; - - } - elsif ( $recursion > Loadbars::Constants->CSSH_MAX_RECURSION ) { - error( "CSSH_MAX_RECURSION reached. Infinite circle loop in " - . Loadbars::Constants->CSSH_CONFFILE - . "?" ); - } - - open my $fh, Loadbars::Constants->CSSH_CONFFILE - or error( "$!: " . Loadbars::Constants->CSSH_CONFFILE ); - my $hosts; - - while (<$fh>) { - if (/^$cluster\s*(.*)/) { - $hosts = $1; - last; - } - } - - close $fh; - - unless ( defined $hosts ) { - error( "No such cluster in " - . Loadbars::Constants->CSSH_CONFFILE - . ": $cluster" ) - unless defined $recursion; - - return ($cluster); - } - - my @hosts; - push @hosts, get_cluster_hosts $_, ( $recursion + 1 ) - for ( split /\s+/, $hosts ); - - return @hosts; -} - -1; diff --git a/lib/Loadbars/Constants.pm b/lib/Loadbars/Constants.pm deleted file mode 100644 index 36e0a91..0000000 --- a/lib/Loadbars/Constants.pm +++ /dev/null @@ -1,44 +0,0 @@ -package Loadbars::Constants; - -use strict; -use warnings; - -use SDL::Color; - -use constant { - COPYRIGHT => '2010-2026 (c) Paul Buetow <loadbars@dev.buetow.org>', - CONFFILE => $ENV{HOME} . '/.loadbarsrc', - CSSH_CONFFILE => '/etc/clusters', - CSSH_MAX_RECURSION => 10, - COLOR_DEPTH => 32, - BLACK => [ 0x00, 0x00, 0x00 ], - BLUE0 => [ 0x00, 0x00, 0xff ], - LIGHT_BLUE => [ 0x00, 0x00, 0xdd ], - LIGHT_BLUE0 => [ 0x00, 0x00, 0xcc ], - BLUE => [ 0x00, 0x00, 0x88 ], - GREEN => [ 0x00, 0x90, 0x00 ], - LIGHT_GREEN => [ 0x00, 0xf0, 0x00 ], - ORANGE => [ 0xff, 0x70, 0x00 ], - PURPLE => [ 0xa0, 0x20, 0xf0 ], - RED => [ 0xff, 0x00, 0x00 ], - WHITE => [ 0xff, 0xff, 0xff ], - GREY0 => [ 0x11, 0x11, 0x11 ], - GREY => [ 0xaa, 0xaa, 0xaa ], - DARK_GREY => [ 0x15, 0x15, 0x15 ], - YELLOW0 => [ 0xff, 0xa0, 0x00 ], - YELLOW => [ 0xff, 0xc0, 0x00 ], - COLOR_WHITE => SDL::Color->new( 0xff, 0xff, 0xff ), - SYSTEM_BLUE0 => 30, - USER_ORANGE => 70, - USER_YELLOW0 => 50, - INTERVAL => 0.14, - INTERVAL_NET => 3.0, - INTERVAL_MEM => 1.0, - INTERVAL_SDL => 0.14, - INTERVAL_SDL_WARN => 1.0, - SUCCESS => 0, - E_UNKNOWN => 1, - E_NOHOST => 2, -}; - -1; diff --git a/lib/Loadbars/HelpDispatch.pm b/lib/Loadbars/HelpDispatch.pm deleted file mode 100644 index bc58ce8..0000000 --- a/lib/Loadbars/HelpDispatch.pm +++ /dev/null @@ -1,332 +0,0 @@ -package Loadbars::HelpDispatch; - -use strict; -use warnings; - -use Loadbars::Constants; -use Loadbars::Shared; - -sub create () { - my $hosts = ''; - - my $textdesc = <<END; -For more help please consult the manual page or press the 'h' hotkey during program execution and watch this terminal window. -END - - # mode 1: Option is shown in the online help menu (stdout not sdl) - # mode 2: Option is shown in the 'usage' screen from the command line - # mode 4: Option is used to generate the GetOptions parameters for Getopt::Long - # Combinations: Like chmod(1) - - my %d = ( - cpuaverage => { - menupos => 3, - help => 'Num of cpu samples for avg. (more fluent animations)', - mode => 6, - type => 'i' - }, - cpuaverage_hot_up => { - menupos => 4, - cmd => 'a', - help => 'Increases number of cpu samples for calculating avg. by 1', - mode => 1 - }, - cpuaverage_hot_dn => { - menupos => 5, - cmd => 'y', - help => 'Decreases number of cpu samples for calculating avg. by 1', - mode => 1 - }, - - netaverage => { - menupos => 6, - help => 'Num of net samples for avg. (more fluent animations)', - mode => 6, - type => 'i' - }, - netaverage_hot_up => { - menupos => 7, - cmd => 'd', - help => 'Increases number of net samples for calculating avg. by 1', - mode => 1 - }, - netaverage_hot_dn => { - menupos => 8, - cmd => 'c', - help => 'Decreases number of net samples for calculating avg. by 1', - mode => 1 - }, - - netint => { - menupos => 6, - help => 'Interface to show netstats for (default: eth0)', - mode => 6, - type => 's' - }, - netint_hot => { - menupos => 17, - cmd => 'n', - help => 'Iterate to next net interface', - mode => 1 - }, - - netlink => { - menupos => 6, - help => -'Force interface link speed (mbit, 10mbit, 100mbit, gbit, 10gbit or a mbytes/s number e.g. 3 for 3mbit)', - mode => 6, - type => 's' - }, - netlink_hot_up => { - menupos => 9, - cmd => 'f', - help => 'Increases net interface link speed reference by factor 10', - mode => 1 - }, - netlink_hot_dn => { - menupos => 10, - cmd => 'v', - help => 'Decreases net interface link speed reference by factor 10', - mode => 1 - }, - - barwidth => { - menupos => 11, - help => 'Set bar width', - mode => 6, - type => 'i' - }, - windowwidth_hot_up => { - menupos => 90, - help => 'Increase window width by 100px', - cmd => 'right', - mode => 1, - }, - windowwidth_hot_dn => { - menupos => 91, - help => 'Decrease window width by 100px', - cmd => 'left', - mode => 1, - }, - windowheight_hot_up => { - menupos => 92, - help => 'Increase window height by 100px', - cmd => 'down', - mode => 1, - }, - windowheight_hot_dn => { - menupos => 93, - help => 'Decrease window height by 100px', - cmd => 'up', - mode => 1, - }, - - cluster => { - menupos => 6, - help => 'Cluster name from /etc/clusters', - var => \$C{cluster}, - mode => 6, - type => 's' - }, - configuration => { - menupos => 6, - cmd => 'c', - help => 'Show current configuration', - mode => 4 - }, - - extended => { - menupos => 6, - help => 'Toggle extended display (0 or 1)', - mode => 7, - type => 'i' - }, - extended_hot => { - menupos => 23, - cmd => 'e', - help => 'Toggle extended mode', - mode => 1 - }, - - hasagent => { - menupos => 10, - help => 'SSH key is already known by the SSH agent (0 or 1)', - mode => 6, - type => 'i' - }, - height => { - menupos => 10, - help => 'Set windows height', - mode => 6, - type => 'i' - }, - - help_hot => { - menupos => 11, - cmd => 'h', - help => 'Prints this help screen', - mode => 1 - }, - - hosts => { - menupos => 12, - help => - 'Comma sep. list of hosts; optional: user@ in front to each host', - var => \$hosts, - mode => 6, - type => 's' - }, - - maxwidth => { - menupos => 16, - help => 'Set max width', - mode => 6, - type => 'i' - }, - - quit_hot => { menupos => 16, cmd => 'q', help => 'Quits', mode => 1 }, - writeconfig_hot => { - menupos => 16, - cmd => 'w', - help => 'Write config to config file', - mode => 1 - }, - - showcores => { - menupos => 17, - help => 'Toggle core display (0 or 1)', - mode => 7, - type => 'i' - }, - showcores_hot => - { menupos => 17, cmd => '1', help => 'Toggle show cores', mode => 1 }, - - showmem => { - menupos => 17, - help => 'Toggle mem display (0 or 1)', - mode => 7, - type => 'i' - }, - showmem_hot => - { menupos => 17, cmd => '2', help => 'Toggle show mem', mode => 1 }, - - shownet => { - menupos => 17, - help => 'Toggle net display (0 or 1)', - mode => 7, - type => 'i' - }, - shownet_hot => - { menupos => 17, cmd => '3', help => 'Toggle show net', mode => 1 }, - - sshopts => - { menupos => 20, help => 'Set SSH options', mode => 6, type => 's' }, - - title => { - menupos => 21, - help => 'Set title bar text', - mode => 6, - type => 's' - }, - ); - - my %d_by_short = map { - $d{$_}{cmd} => $d{$_} - - } grep { - exists $d{$_}{cmd} - - } keys %d; - - my $closure = sub ($;$) { - my ( $arg, @rest ) = @_; - - if ( $arg eq 'command' ) { - my ( $cmd, @args ) = @rest; - - my $cb = $d{$cmd}; - $cb = $d_by_short{$cmd} unless defined $cb; - - unless ( defined $cb ) { - system $cmd; - return 0; - } - - if ( length $cmd == 1 ) { - for my $key ( grep { exists $d{$_}{cmd} } keys %d ) { - do { $cmd = $key; last } if $d{$key}{cmd} eq $cmd; - } - } - - } - elsif ( $arg eq 'hotkeys' ) { - $textdesc . "Hotkeys:\n" . ( - join "\n", - map { - "$_ - $d_by_short{$_}{help}" - - } grep { - $d_by_short{$_}{mode} & 1 and exists $d_by_short{$_}{help}; - - } sort { $d_by_short{$a}{menupos} <=> $d_by_short{$b}{menupos} } - sort keys %d_by_short - ); - - } - elsif ( $arg eq 'usage' ) { - $textdesc . ( - join "\n", - map { - if ( $_ eq 'help' ) - { - "--$_ - $d{$_}{help}"; - } - else { - "--$_ <ARG> - $d{$_}{help}"; - } - - } grep { - $d{$_}{mode} & 2 - and exists $d{$_}{help} - - } sort { $d{$a}{menupos} <=> $d{$b}{menupos} } sort keys %d - ); - - } - elsif ( $arg eq 'options' ) { - map { - "$_=" - . $d{$_}{type} => ( - defined $d{$_}{var} - ? $d{$_}{var} - : \$C{$_} - ); - - } grep { - $d{$_}{mode} & 4 and exists $d{$_}{type}; - - } sort keys %d; - } - }; - - $d{configuration}{cb} = sub { - Loadbars::Main::say sort map { - "$_->[0] = $_->[1]" - - } grep { - defined $_->[1] - - } map { - [ - $_ => exists $d{$_}{var} - ? ${ $d{$_}{var} } - : $C{$_} - ] - - } keys %d; - }; - - return ( \$hosts, $closure ); -} - -1; diff --git a/lib/Loadbars/Main.pm b/lib/Loadbars/Main.pm deleted file mode 100644 index 4b750dc..0000000 --- a/lib/Loadbars/Main.pm +++ /dev/null @@ -1,1092 +0,0 @@ -package Loadbars::Main; - -use strict; -use warnings; -use v5.14; -use autodie; - -use SDL; -use SDL::Event; -use SDL::Events; -use SDL::Rect; -use SDL::Surface; -use SDL::Video; -use SDLx::App; - -use Time::HiRes qw(gettimeofday); - -use Proc::ProcessTable; - -use threads; -use threads::shared; - -use Loadbars::Config; -use Loadbars::Constants; -use Loadbars::Shared; -use Loadbars::Utils; - -use Carp; -$SIG{__DIE__} = sub { Carp::confess(@_) }; - -$| = 1; - -sub cpu_set_showcores_re () { - $I{cpustring} = $C{showcores} ? 'cpu' : 'cpu '; -} - -sub percentage ($$) { - my ( $total, $part ) = @_; - - return int( null($part) / notnull( null($total) / 100 ) ); -} - -sub max_100 ($) { - return $_[0] > 100 ? 100 : $_[0]; -} - -sub percentage_norm ($$$) { - my ( $total, $part, $norm ) = @_; - - return int( null($part) / notnull( null($total) / 100 ) / notnull $norm); -} - -sub norm ($) { - my $n = shift; - - return $n > 100 ? 100 : ( $n < 0 ? 0 : $n ); -} - -sub cpu_parse_line ($) { - my $line = shift; - my ( $name, %load ); - - # Modern kernels (2.6.33+) have 10 fields: user nice system idle iowait irq softirq steal guest guest_nice - ( $name, @load{qw(user nice system idle iowait irq softirq steal guest guest_nice)} ) = - split ' ', $line; - - # Not all kernels support these fields - $load{steal} = 0 unless defined $load{steal}; - $load{guest} = 0 unless defined $load{guest}; - $load{guest_nice} = 0 unless defined $load{guest_nice}; - - $load{TOTAL} = - sum( @load{qw(user nice system idle iowait irq softirq steal guest guest_nice)} ); - - return ( $name, \%load ); -} - -sub threads_terminate_pids (@) { - my @threads = @_; - - display_info 'Terminating sub-processes, hasta la vista!'; - $_->kill('TERM') for @threads; - display_info_no_nl 'Terminating PIDs'; - for my $pid ( keys %PIDS ) { - my $proc_table = Proc::ProcessTable->new(); - for my $proc ( @{ $proc_table->table() } ) { - if ( $proc->ppid == $pid ) { - print $proc->pid . ' '; - kill 'TERM', $proc->pid if $proc->ppid == $pid; - } - } - - print $pid . ' '; - kill 'TERM', $pid; - - #$_->join() for @threads; - } - - say ''; - - display_info 'Terminating done. I\'ll be back!'; -} - -sub threads_stats ($;$) { - my ( $host, $user ) = @_; - $user = defined $user ? "-l $user" : ''; - - my ( $sigusr1, $sigterm ) = ( 0, 0 ); - my $interval = Loadbars::Constants->INTERVAL; - - my $cpustring = $I{cpustring}; - - # Precompile some regexp - my @meminfo = - map { [ $_, qr/^$_: *(\d+)/ ] } - (qw(MemTotal MemFree Buffers Cached SwapTotal SwapFree)); - - my $modeswitch_re = qr/^M /; - - # UGLY! - my $remotecode = <<"REMOTECODE"; - perl -le ' - use strict; - use Time::HiRes qw(usleep); - - my \\\$whitespace_re = qr/ +/; - my \\\$usleep = $interval * 100000; - - sub cat { - my \\\$file = shift; - open FH, \\\$file; - while (<FH>) { - print; - } - close FH; - } - - sub load { - printf qq(M LOADAVG\n); - open FH, qq(/proc/loadavg); - printf qq(%s\n), join qq(;), (split qq( ), <FH>)[0..2]; - close FH; - } - - sub mem { - printf qq(M MEMSTATS\n); - cat(qq(/proc/meminfo)); - } - - sub net { - printf qq(M NETSTATS\n); - open FH, qq(/proc/net/dev); - <FH>; <FH>; - while (<FH>) { - next unless s/:/ /; - my (\\\$foo, \\\$int, \\\$bytes, \\\$packets, \\\$errs, \\\$drop, \\\$fifo, \\\$frame, \\\$compressed, \\\$multicast, \\\$tbytes, \\\$tpackets, \\\$terrs, \\\$tdrop, \\\$tfifo, \\\$tcolls, \\\$tcarrier, \\\$tcompressed) = split \\\$whitespace_re, \\\$_; - if (\\\$bytes || \\\$tbytes) { - printf qq(%s:b=%s;tb=%s;p=%s;tp=%s e=%s;te=%s;d=%s;td=%s\n), \\\$int, - \\\$bytes, \\\$tbytes, - \\\$packets, \\\$tpackets, - \\\$errs, \\\$terrs, - \\\$drop, \\\$tdrop - ; - } - } - close FH; - } - - for (1..10000) { - load(); - mem(); - net(); - - printf qq(M CPUSTATS\n); - for (1..20) { - cat(qq(/proc/stat)); - usleep(\\\$usleep); - } - } - ' -REMOTECODE - - my $cmd = - ( $host eq 'localhost' || $host eq '127.0.0.1' ) - ? "bash -c \"$remotecode\"" - : "ssh $user -o StrictHostKeyChecking=no $C{sshopts} $host \"$remotecode\""; - - my $pid = open my $pipe, "$cmd |" or do { - say "Warning: $!"; - sleep 1; - next; - }; - - $PIDS{$pid} = 1; - - # Toggle CPUs - $SIG{USR1} = sub { $sigusr1 = 1 }; - $SIG{TERM} = sub { threads->exit(); }; - - my $mode = 0; - - while (<$pipe>) { - chomp; - - if ( $_ =~ $modeswitch_re ) { - if ( $_ eq 'M CPUSTATS' ) { - $mode = 1; - } - elsif ( $_ eq 'M MEMSTATS' ) { - $mode = 2; - } - elsif ( $_ eq 'M NETSTATS' ) { - $mode = 3; - } - elsif ( $_ eq 'M LOADAVG' ) { - $mode = 0; - } - next; - } - - if ( $mode == 0 ) { - $AVGSTATS{$host} = $_; - $AVGSTATS_HAS{$host} = 1; - } - elsif ( $mode == 1 ) { - if ( 0 == index $_, $cpustring ) { - my ( $name, $load ) = cpu_parse_line $_; - $CPUSTATS{"$host;$name"} = join ';', - map { $_ . '=' . $load->{$_} } - grep { defined $load->{$_} } keys %$load; - } - } - elsif ( $mode == 2 ) { - for my $meminfo (@meminfo) { - if ( $_ =~ $meminfo->[1] ) { - $MEMSTATS{"$host;$meminfo->[0]"} = $1; - $MEMSTATS_HAS{$host} = 1 - unless defined $MEMSTATS_HAS{$host}; - } - } - } - elsif ( $mode == 3 ) { - my ( $int, @stats ) = split ':', $_; - $NETSTATS{"$host;$int"} = "@stats"; - $NETSTATS{"$host;$int;stamp"} = Time::HiRes::time(); - $NETSTATS_INT{$int} = 1 unless defined $NETSTATS_INT{$int}; - $NETSTATS_HAS{$host} = 1 unless defined $NETSTATS_HAS{$host}; - } - - if ($sigusr1) { - $cpustring = $I{cpustring}; - $sigusr1 = 0; - - } - } - - delete $PIDS{$pid}; - - return undef; -} - -sub sdl_get_rect ($$) { - my ( $rects, $name ) = @_; - - return $rects->{$name} if exists $rects->{$name}; - return $rects->{$name} = SDL::Rect->new( 0, 0, 0, 0 ); -} - -sub cpu_normalize_loads ($) { - my $cpu_loads_r = shift; - - return $cpu_loads_r unless exists $cpu_loads_r->{TOTAL}; - - my $total = $cpu_loads_r->{TOTAL} == 0 ? 1 : $cpu_loads_r->{TOTAL}; - my %cpu_loads = - map { $_ => $cpu_loads_r->{$_} / ( $total / 100 ) } keys %$cpu_loads_r; - return \%cpu_loads; -} - -sub cpu_parse ($) { - my ($line_r) = shift; - - my %stat = map { - my ( $k, $v ) = split '='; - $k => $v - } split ';', $$line_r; - - return \%stat; -} - -sub net_link () { - my $key = "bytes_$C{netlink}"; - - my $linkspeed = do { - if ( defined $I{$key} ) { - $I{$key}; - - } - else { - int $C{netlink} * $I{bytes_mbit}; - } - }; - - my $mbit = $linkspeed / $I{bytes_mbit}; - - display_warn "$mbit mbit/s is no valid reference link speed" - unless $mbit > 0; - - display_info "Setting reference linkspeed to $mbit mbit/s"; - - return $linkspeed; -} - -sub net_next_int ($;$) { - my ( $num, $initial_device_flag ) = @_; - - return $C{netint} if defined $initial_device_flag && $C{netint} ne ''; - - my $int = undef; - - for ( ; ; ) { - my @ints = sort keys %NETSTATS_INT; - $int = $ints[ int( $num % @ints ) ] if @ints; - - unless ( defined $int ) { - sleep 0.1; - next; - } - - # On startup dont show a loopback device net interface - if ( defined $initial_device_flag && $int =~ /^lo/ ) { - $num++; - sleep 0.1; - next; - } - - last; - } - - return $int; -} - -sub net_parse ($) { - my ($line_r) = shift; - my ( $a, $b ) = split ' ', $$line_r; - - my %a = map { - my ( $k, $v ) = split '=', $_; - $k => $v; - - } split ';', $a; - - my %b = map { - my ( $k, $v ) = split '=', $_; - $k => $v; - - } split ';', $b; - - return [ \%a, \%b ]; -} - -sub net_diff ($$) { - my ( $a_r, $b_r ) = @_; - my %diff = map { $_ => ( $a_r->{$_} - $b_r->{$_} ) } keys %$a_r; - - return \%diff; -} - -sub sdl_fill_rect { - my ( $app, $rect, $color ) = @_; - - my $mapped_color = SDL::Video::map_RGB( $app->format(), @$color ); - SDL::Video::fill_rect( $app, $rect, $mapped_color ); - - return undef; -} - -sub sdl_draw_background ($$) { - my ( $app, $rects ) = @_; - my $rect = sdl_get_rect $rects, 'background'; - - $rect->w( $C{width} ); - $rect->h( $C{height} ); - sdl_fill_rect( $app, $rect, Loadbars::Constants->BLACK ); - - return undef; -} - -sub threads_create (@) { - return map { $_->detach(); $_ } - map { threads->create( 'threads_stats', split ':' ) } @_; -} - -sub set_dimensions ($$) { - my ( $width, $height ) = @_; - my $display_info = 0; - - if ( $width < 1 ) { - $C{width} = 1 if $C{width} != 1; - - } - elsif ( $width > $C{maxwidth} ) { - $C{width} = $C{maxwidth} if $C{width} != $C{maxwidth}; - - } - elsif ( $C{width} != $width ) { - $C{width} = $width; - } - - if ( $height < 1 ) { - $C{height} = 1 if $C{height} != 1; - - } - elsif ( $C{height} != $height ) { - $C{height} = $height; - } -} - -sub loop ($@) { - my ( $dispatch, @threads ) = @_; - - my $num_stats = 1; - $C{width} = $C{barwidth}; - - my $title = do { - if ( defined $C{title} ) { - $C{title}; - } - else { - 'Loadbars ' . get_version . ' (press h for help on stdout)'; - } - }; - - my $app = SDLx::App->new( - title => $title, - icon_title => Loadbars::Constants->VERSION, - width => $C{width}, - height => $C{height}, - depth => Loadbars::Constants->COLOR_DEPTH, - resizeable => 1, - ); - - my $rects = {}; - my %cpu_history; - my %cpu_max; - - my %net_history; - my %net_history_stamps; - my %net_last_value; - my $net_int_number = 0; - my $net_int = net_next_int $net_int_number, 1; - - my $net_max_bytes = net_link; - - my $sdl_redraw_background = 0; - my $sdl_font_height = 14; - - my $infotxt : shared = ''; - my $quit : shared = 0; - my $resize_window : shared = 0; - my %newsize : shared; - my $event = SDL::Event->new(); - - my ( $t1, $t2 ) = ( Time::HiRes::time(), undef ); - - # Closure for event handling - my $event_handler = sub { - - # While there are events to poll, poll them all! - while ( SDL::Events::poll_event($event) ) { - - # Videoresize - if ( $event->type() == 16 ) { - $newsize{width} = $event->resize_w; - $newsize{height} = $event->resize_h; - $resize_window = 1; - } - - # Not a key - next if $event->type() != 2; - my $key_sym = $event->key_sym(); - - if ( $key_sym == 49 ) { - - # 1 pressed - $C{showcores} = !$C{showcores}; - cpu_set_showcores_re; - $_->kill('USR1') for @threads; - $sdl_redraw_background = 1; - display_info "Toggled CPUs $C{showcores}"; - - } - elsif ( $key_sym == 50 ) { - - # 2 pressed - $C{showmem} = !$C{showmem}; - display_info "Toggled show mem"; - - } - elsif ( $key_sym == 51 ) { - - # 3 pressed - $C{shownet} = !$C{shownet}; - display_info "Toggled show net $C{shownet}"; - display_info "Net interface speed reference is " - . ( $net_max_bytes / $I{bytes_mbit} ) - . "mbit/s. Press f/v to scale" - if $C{shownet}; - } - - elsif ( $key_sym == 101 ) { - - # e pressed - $C{extended} = !$C{extended}; - $sdl_redraw_background = 1; - display_info "Toggled extended display $C{extended}"; - - } - elsif ( $key_sym == 104 ) { - - # h pressed - say '=> Hotkeys to use in the SDL interface'; - say $dispatch->('hotkeys'); - display_info 'Hotkeys help printed on terminal stdout'; - - } - elsif ( $key_sym == 109 ) { - - # m pressed - display_warn -"Toggled show mem hotkey m is deprecated. Press 2 hotkey instead"; - - } - elsif ( $key_sym == 110 ) { - - # n pressed - if ( $C{shownet} ) { - $net_int = net_next_int ++$net_int_number; - $sdl_redraw_background = 1; - display_info "Using net interface which is $net_int"; - } - else { - display_warn -"Net stats are not activated. Press 3 hotkey to activate first"; - } - - } - elsif ( $key_sym == 113 ) { - - # q pressed - threads_terminate_pids @threads; - $quit = 1; - return; - - } - elsif ( $key_sym == 119 ) { - - # w pressed - Loadbars::Config::write; - - } - elsif ( $key_sym == 97 ) { - - # a pressed - ++$C{cpuaverage}; - display_info "Set sample cpu average $C{cpuaverage}"; - } - elsif ( $key_sym == 121 or $key_sym == 122 ) { - - # y or z pressed - my $avg = $C{cpuaverage}; - --$avg; - $C{cpuaverage} = $avg > 1 ? $avg : 2; - display_info "Set sample cpu average $C{cpuaverage}"; - - } - elsif ( $key_sym == 100 ) { - - # d pressed - ++$C{netaverage}; - display_info "Set sample net average $C{netaverage}"; - } - elsif ( $key_sym == 99 ) { - - # c pressed - my $avg = $C{netaverage}; - --$avg; - $C{netaverage} = $avg > 1 ? $avg : 2; - display_info "Set sample net average $C{netaverage}"; - - } - elsif ( $key_sym == 102 ) { - - # f pressed - $net_max_bytes *= 10; - display_info "Set net interface speed reference to " - . ( $net_max_bytes / $I{bytes_mbit} ) - . 'mbit/s'; - } - elsif ( $key_sym == 118 ) { - - # v pressed - $net_max_bytes = int( $net_max_bytes / 10 ); - $net_max_bytes = $I{bytes_mbit} - if $net_max_bytes < $I{bytes_mbit}; - display_info "Set net interface speed reference to " - . int( $net_max_bytes / $I{bytes_mbit} ) - . 'mbit/s'; - - } - elsif ( $key_sym == 276 ) { - - # left pressed - $newsize{width} = $C{width} - 100; - $newsize{height} = $C{height}; - $resize_window = 1; - } - elsif ( $key_sym == 275 ) { - - # right pressed - $newsize{width} = $C{width} + 100; - $newsize{height} = $C{height}; - $resize_window = 1; - - } - elsif ( $key_sym == 273 ) { - - # up pressed - $newsize{width} = $C{width}; - $newsize{height} = $C{height} - 100; - $resize_window = 1; - } - elsif ( $key_sym == 274 ) { - - # down pressed - $newsize{width} = $C{width}; - $newsize{height} = $C{height} + 100; - $resize_window = 1; - } - } - }; - - do { - my ( $x, $y ) = ( 0, 0 ); - - # Also substract 1 (each bar is followed by an 1px separator bar) - my $width = $C{width} / notnull($num_stats) - 1; - - my ( $current_barnum, $current_corenum ) = ( -1, -1 ); - - for my $key ( sort keys %CPUSTATS ) { - last if ( ++$current_barnum > $num_stats ); - ++$current_corenum; - my ( $host, $name ) = split ';', $key; - - next unless defined $CPUSTATS{$key}; - - $cpu_history{$key} = [ cpu_parse \$CPUSTATS{$key} ] - unless exists $cpu_history{$key} && exists $CPUSTATS{$key}; - - my $now_stat_r = cpu_parse \$CPUSTATS{$key}; - my $prev_stat_r = $cpu_history{$key}[0]; - - push @{ $cpu_history{$key} }, $now_stat_r; - shift @{ $cpu_history{$key} } - while $C{cpuaverage} < @{ $cpu_history{$key} }; - - my %cpu_loads = - null $now_stat_r->{TOTAL} == null $prev_stat_r->{TOTAL} - ? %$now_stat_r - : map { $_ => $now_stat_r->{$_} - $prev_stat_r->{$_} } - keys %$now_stat_r; - - my $cpu_loads_r = cpu_normalize_loads \%cpu_loads; - - my %heights = map { - $_ => defined $cpu_loads_r->{$_} - ? $cpu_loads_r->{$_} * ( $C{height} / 100 ) - : 1 - } keys %$cpu_loads_r; - - push @{ $cpu_max{$key} }, $cpu_loads_r; - shift @{ $cpu_max{$key} } - while $C{cpuaverage} < @{ $cpu_max{$key} }; - - my $is_host_summary = $name eq 'cpu' ? 1 : 0; - - my $rect_separator = undef; - - my $rect_idle = sdl_get_rect $rects, "$key;idle"; - my $rect_steal = sdl_get_rect $rects, "$key;steal"; - my $rect_guest = sdl_get_rect $rects, "$key;guest"; - my $rect_irq = sdl_get_rect $rects, "$key;irq"; - my $rect_softirq = sdl_get_rect $rects, "$key;softirq"; - my $rect_nice = sdl_get_rect $rects, "$key;nice"; - my $rect_iowait = sdl_get_rect $rects, "$key;iowait"; - my $rect_user = sdl_get_rect $rects, "$key;user"; - my $rect_system = sdl_get_rect $rects, "$key;system"; - - my $rect_peak; - - $y = $C{height} - $heights{system}; - $rect_system->w($width); - $rect_system->h( $heights{system} ); - $rect_system->x($x); - $rect_system->y($y); - - $y -= $heights{user}; - $rect_user->w($width); - $rect_user->h( $heights{user} ); - $rect_user->x($x); - $rect_user->y($y); - - $y -= $heights{nice}; - $rect_nice->w($width); - $rect_nice->h( $heights{nice} ); - $rect_nice->x($x); - $rect_nice->y($y); - - $y -= $heights{idle}; - $rect_idle->w($width); - $rect_idle->h( $heights{idle} ); - $rect_idle->x($x); - $rect_idle->y($y); - - $y -= $heights{iowait}; - $rect_iowait->w($width); - $rect_iowait->h( $heights{iowait} ); - $rect_iowait->x($x); - $rect_iowait->y($y); - - $y -= $heights{irq}; - $rect_irq->w($width); - $rect_irq->h( $heights{irq} ); - $rect_irq->x($x); - $rect_irq->y($y); - - $y -= $heights{softirq}; - $rect_softirq->w($width); - $rect_softirq->h( $heights{softirq} ); - $rect_softirq->x($x); - $rect_softirq->y($y); - - $y -= $heights{guest}; - $rect_guest->w($width); - $rect_guest->h( $heights{guest} ); - $rect_guest->x($x); - $rect_guest->y($y); - - $y -= $heights{steal}; - $rect_steal->w($width); - $rect_steal->h( $heights{steal} ); - $rect_steal->x($x); - $rect_steal->y($y); - - my $all = 100 - $cpu_loads_r->{idle}; - my $max_all = 0; - - sdl_fill_rect( $app, $rect_idle, Loadbars::Constants->BLACK ); - sdl_fill_rect( $app, $rect_steal, Loadbars::Constants->RED ); - sdl_fill_rect( $app, $rect_guest, Loadbars::Constants->RED ); - sdl_fill_rect( $app, $rect_irq, Loadbars::Constants->WHITE ); - sdl_fill_rect( $app, $rect_softirq, Loadbars::Constants->WHITE ); - sdl_fill_rect( $app, $rect_nice, Loadbars::Constants->GREEN ); - sdl_fill_rect( $app, $rect_iowait, Loadbars::Constants->PURPLE ); - - my $rect_memused = sdl_get_rect $rects, "$host;memused"; - my $rect_memfree = sdl_get_rect $rects, "$host;memfree"; - - #my $rect_buffers = sdl_get_rect $rects, "$host;buffers"; - #my $rect_cached = sdl_get_rect $rects, "$host;cached"; - my $rect_swapused = sdl_get_rect $rects, "$host;swapused"; - my $rect_swapfree = sdl_get_rect $rects, "$host;swapfree"; - - my $rect_netused = sdl_get_rect $rects, "$host;netused"; - my $rect_netfree = sdl_get_rect $rects, "$host;netfree"; - - my $rect_tnetused = sdl_get_rect $rects, "$host;tnetused"; - my $rect_tnetfree = sdl_get_rect $rects, "$host;tnetfree"; - - my $add_x = 0; - my $half_width = $width / 2; - - my %meminfo; - if ($is_host_summary) { - if ( $C{showmem} ) { - $add_x += $width + 1; - - my $ram_per = percentage $MEMSTATS{"$host;MemTotal"}, - $MEMSTATS{"$host;MemFree"}; - my $swap_per = percentage $MEMSTATS{"$host;SwapTotal"}, - $MEMSTATS{"$host;SwapFree"}; - - %meminfo = ( - ram_per => $ram_per, - swap_per => $swap_per, - ); - - my %heights = ( - MemFree => $ram_per * ( $C{height} / 100 ), - MemUsed => ( 100 - $ram_per ) * ( $C{height} / 100 ), - SwapFree => $swap_per * ( $C{height} / 100 ), - SwapUsed => ( 100 - $swap_per ) * ( $C{height} / 100 ), - ); - - $y = $C{height} - $heights{MemUsed}; - $rect_memused->w($half_width); - $rect_memused->h( $heights{MemUsed} ); - $rect_memused->x( $x + $add_x ); - $rect_memused->y($y); - - $y -= $heights{MemFree}; - $rect_memfree->w($half_width); - $rect_memfree->h( $heights{MemFree} ); - $rect_memfree->x( $x + $add_x ); - $rect_memfree->y($y); - - $y = $C{height} - $heights{SwapUsed}; - $rect_swapused->w($half_width); - $rect_swapused->h( $heights{SwapUsed} ); - $rect_swapused->x( $x + $add_x + $half_width ); - $rect_swapused->y($y); - - $y -= $heights{SwapFree}; - $rect_swapfree->w($half_width); - $rect_swapfree->h( $heights{SwapFree} ); - $rect_swapfree->x( $x + $add_x + $half_width ); - $rect_swapfree->y($y); - - sdl_fill_rect( $app, $rect_memused, - Loadbars::Constants->DARK_GREY ); - sdl_fill_rect( $app, $rect_memfree, - Loadbars::Constants->BLACK ); - - sdl_fill_rect( $app, $rect_swapused, - Loadbars::Constants->GREY ); - sdl_fill_rect( $app, $rect_swapfree, - Loadbars::Constants->BLACK ); - } - - if ( $C{shownet} && exists $NETSTATS_HAS{$host} ) { - $add_x += $width + 1; - - my $key = "$host;$net_int"; - my %heights; - - if ( exists $NETSTATS{$key} ) { - - unless ( exists $net_history{$key} ) { - $net_history{$key} = [ net_parse \$NETSTATS{$key} ]; - $net_history_stamps{$key} = - [ $NETSTATS{"$key;stamp"} ]; - } - - my $now_stat_stamp = $NETSTATS{"$key;stamp"}; - my $now_stat_r = net_parse \$NETSTATS{$key}; - - my $prev_stat_stamp = $net_history_stamps{$key}[0]; - - my $net_factor = $net_max_bytes * - ( $now_stat_stamp - $prev_stat_stamp ); - - push @{ $net_history_stamps{$key} }, $now_stat_stamp; - shift @{ $net_history_stamps{$key} } - while $C{netaverage} < @{ $net_history_stamps{$key} }; - - my $prev_stat_r = $net_history{$key}[0]; - - push @{ $net_history{$key} }, $now_stat_r; - shift @{ $net_history{$key} } - while $C{netaverage} < @{ $net_history{$key} }; - - my $diff_stat_r = net_diff $now_stat_r->[0], - $prev_stat_r->[0]; - - my $net_per = - percentage( $net_factor, $diff_stat_r->{b} ); - my $tnet_per = - percentage( $net_factor, $diff_stat_r->{tb} ); - - if ( $net_per < 0 ) { - $net_per = $net_last_value{"$key;per"}; - } - else { - $net_last_value{"$key;per"} = $net_per; - } - - if ( $tnet_per < 0 ) { - $tnet_per = $net_last_value{"$key;tper"}; - } - else { - $net_last_value{"$key;tper"} = $tnet_per; - } - - my $net_per_100 = max_100 $net_per; - my $tnet_per_100 = max_100 $tnet_per; - - %heights = ( - NetUsed => $net_per_100 * ( $C{height} / 100 ), - NetFree => ( 100 - $net_per_100 ) * - ( $C{height} / 100 ), - TNetFree => $tnet_per_100 * ( $C{height} / 100 ), - TNetUsed => ( 100 - $tnet_per_100 ) * - ( $C{height} / 100 ), - ); - - $y = $C{height} - $heights{NetFree}; - $rect_netused->w($half_width); - $rect_netused->h( $heights{NetFree} ); - $rect_netused->x( $x + $add_x ); - $rect_netused->y($y); - - $y -= $heights{NetUsed}; - $rect_netfree->w($half_width); - $rect_netfree->h( $heights{NetUsed} ); - $rect_netfree->x( $x + $add_x ); - $rect_netfree->y($y); - - $y = $C{height} - $heights{TNetFree}; - $rect_tnetused->w($half_width); - $rect_tnetused->h( $heights{TNetFree} ); - $rect_tnetused->x( $x + $add_x + $half_width ); - $rect_tnetused->y($y); - - $y -= $heights{TNetUsed}; - $rect_tnetfree->w($half_width); - $rect_tnetfree->h( $heights{TNetUsed} ); - $rect_tnetfree->x( $x + $add_x + $half_width ); - $rect_tnetfree->y($y); - - sdl_fill_rect( $app, $rect_netused, - Loadbars::Constants->BLACK ); - sdl_fill_rect( $app, $rect_netfree, - $net_per > 100 - ? Loadbars::Constants->GREEN - : Loadbars::Constants->LIGHT_GREEN ); - - sdl_fill_rect( $app, $rect_tnetused, - $tnet_per > 100 - ? Loadbars::Constants->GREEN - : Loadbars::Constants->LIGHT_GREEN ); - sdl_fill_rect( $app, $rect_tnetfree, - Loadbars::Constants->BLACK ); - - # No netstats available for this host;device pair. - } - else { - $rect_netused->w($width); - $rect_netused->h( $C{height} ); - $rect_netused->x( $x + $add_x ); - $rect_netused->y($y); - - sdl_fill_rect( $app, $rect_netused, - Loadbars::Constants->RED ); - sdl_fill_rect( $app, $rect_tnetused, - Loadbars::Constants->RED ); - sdl_fill_rect( $app, $rect_netfree, - Loadbars::Constants->RED ); - sdl_fill_rect( $app, $rect_tnetfree, - Loadbars::Constants->RED ); - } - - } - - if ( $C{showcores} ) { - $current_corenum = 0; - $rect_separator = sdl_get_rect $rects, "$key;separator"; - $rect_separator->w(1); - $rect_separator->h( $C{height} ); - $rect_separator->x( $x - 1 ); - $rect_separator->y(0); - sdl_fill_rect( $app, $rect_separator, - Loadbars::Constants->GREY ); - } - } - - if ( $C{extended} ) { - my $max_val = 0; - - for ( @{ $cpu_max{$key} } ) { - my $new_val = sum @{$_}{qw{system user}}; - $max_val = $new_val if $max_val < $new_val; - } - - my $maxheight = $max_val * ( $C{height} / 100 ); - - $rect_peak = sdl_get_rect $rects, "$key;max"; - $rect_peak->w($width); - $rect_peak->h(1); - $rect_peak->x($x); - $rect_peak->y( $C{height} - $maxheight ); - - sdl_fill_rect( - $app, - $rect_peak, - $max_val > Loadbars::Constants->USER_ORANGE - ? Loadbars::Constants->ORANGE - : ( - $max_val > Loadbars::Constants->USER_YELLOW0 - ? Loadbars::Constants->YELLOW0 - : ( Loadbars::Constants->YELLOW ) - ) - ); - } - - sdl_fill_rect( - $app, - $rect_user, - $all > Loadbars::Constants->USER_ORANGE - ? Loadbars::Constants->ORANGE - : ( - $all > Loadbars::Constants->USER_YELLOW0 - ? Loadbars::Constants->YELLOW0 - : ( Loadbars::Constants->YELLOW ) - ) - ); - sdl_fill_rect( $app, $rect_system, - $cpu_loads_r->{system} > Loadbars::Constants->SYSTEM_BLUE0 - ? Loadbars::Constants->BLUE0 - : Loadbars::Constants->BLUE ); - - my $y = 5; - - my @loadavg = do { - if ( defined $AVGSTATS_HAS{$host} ) { - split ';', $AVGSTATS{$host}; - } - else { - ( undef, undef, undef ); - } - }; - - $app->sync(); - $x += $width + 1 + $add_x; - } - - TIMEKEEPER: - $t2 = Time::HiRes::time(); - my $t_diff = $t2 - $t1; - - if ( Loadbars::Constants->INTERVAL_SDL > $t_diff ) { - SDL::delay(10); - - # Goto is OK as long you don't produce spaghetti code - goto TIMEKEEPER; - - } - elsif ( Loadbars::Constants->INTERVAL_SDL_WARN < $t_diff ) { - display_warn -"WARN: Loop is behind $t_diff seconds, your computer may be too slow"; - } - - $t1 = $t2; - $event_handler->(); - - my $new_num_stats = keys %CPUSTATS; - $new_num_stats += keys %MEMSTATS_HAS if $C{showmem}; - $new_num_stats += keys %NETSTATS_HAS if $C{shownet}; - - if ( $new_num_stats != $num_stats ) { - %cpu_history = (); - %net_history = (); - - $num_stats = $new_num_stats; - $newsize{width} = $C{barwidth} * $num_stats; - $newsize{height} = $C{height}; - $resize_window = 1; - } - - if ($resize_window) { - set_dimensions $newsize{width}, $newsize{height}; - $app->resize( $C{width}, $C{height} ); - $resize_window = 0; - $sdl_redraw_background = 1; - } - - if ($sdl_redraw_background) { - sdl_draw_background $app, $rects; - $sdl_redraw_background = 0; - %AVGSTATS = (); - %AVGSTATS_HAS = (); - %CPUSTATS = (); - } - - } until $quit; - - say "Good bye"; - - exit Loadbars::Constants->SUCCESS; -} - -1; diff --git a/lib/Loadbars/Shared.pm b/lib/Loadbars/Shared.pm deleted file mode 100644 index 1cf6e80..0000000 --- a/lib/Loadbars/Shared.pm +++ /dev/null @@ -1,67 +0,0 @@ -package Loadbars::Shared; - -use Exporter; - -use base 'Exporter'; - -our @EXPORT = qw( - %PIDS - %CPUSTATS - %NETSTATS_LASTUPDATE - %AVGSTATS - %AVGSTATS_HAS - %MEMSTATS - %MEMSTATS_HAS - %NETSTATS - %NETSTATS_HAS - %NETSTATS_INT - %C - %I -); - -our %PIDS : shared; - -our %CPUSTATS : shared; -our %AVGSTATS : shared; -our %AVGSTATS_HAS : shared; - -our %MEMSTATS : shared; -our %MEMSTATS_HAS : shared; - -our %NETSTATS : shared; -our %NETSTATS_HAS : shared; -our %NETSTATS_INT : shared; - -# Global configuration hash -our %C : shared; - -# Global configuration hash for internal settings (not configurable) -our %I : shared; - -# Setting defaults -%C = ( - title => undef, - barwidth => 20, - cpuaverage => 10, - extended => 0, - hasagent => 0, - height => 150, - maxwidth => 1900, - netaverage => 15, - netint => '', - netlink => 'gbit', - showcores => 0, - showmem => 0, - shownet => 0, - sshopts => '', -); - -%I = ( - cpustring => 'cpu', - bytes_mbit => 125000, - bytes_10mbit => 1250000, - bytes_100mbit => 12500000, - bytes_gbit => 125000000, - bytes_10gbit => 1250000000, -); - diff --git a/lib/Loadbars/Utils.pm b/lib/Loadbars/Utils.pm deleted file mode 100644 index 56b829d..0000000 --- a/lib/Loadbars/Utils.pm +++ /dev/null @@ -1,61 +0,0 @@ -package Loadbars::Utils; - -use strict; -use warnings; - -use Exporter; - -use base 'Exporter'; - -our @EXPORT = qw ( - debugsay - display_info - display_info_no_nl - display_warn - error - get_version - newline - notnull - null - say - sum - trim -); - -sub say (@) { print "$_\n" for @_; return undef } -sub newline () { say ''; return undef } -sub debugsay (@) { say "Loadbars::DEBUG: $_" for @_; return undef } -sub sum (@) { my $sum = 0; $sum += $_ // 0 for @_; return $sum } -sub null ($) { defined $_[0] ? $_[0] : 0 } -sub notnull ($) { $_[0] != 0 ? $_[0] : 1 } -sub error ($) { die shift, "\n" } - -sub trim (\$) { - my $str = shift; - $$str =~ s/^[\s\t]+//; - $$str =~ s/[\s\t]+$//; - return undef; -} -sub display_info_no_nl ($) { print "==> " . (shift) . ' ' } -sub display_info ($) { say "==> " . shift } -sub display_warn ($) { say "!!! " . shift } - -sub get_version () { - my $versionfile = do { - if ( -f '.version' ) { - '.version'; - } - else { - '/usr/share/loadbars/version'; - } - }; - - open my $fh, $versionfile or error("$!: $versionfile"); - my $version = <$fh>; - close $fh; - - chomp $version; - return $version; -} - -1; |
