summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorPaul Buetow <paul@buetow.org>2026-02-13 23:47:59 +0200
committerPaul Buetow <paul@buetow.org>2026-02-13 23:47:59 +0200
commit39b8ed83ed0e9c30fda39e978b1b2e3ffeaa2288 (patch)
tree420bb66055675cf8fc04a23fd64d909ead8e9e8a /lib
parent8a2251d1fceaed3c563c4916b6b43b03fd44b7c8 (diff)
cleanup
Diffstat (limited to 'lib')
-rw-r--r--lib/Loadbars/Config.pm110
-rw-r--r--lib/Loadbars/Constants.pm44
-rw-r--r--lib/Loadbars/HelpDispatch.pm332
-rw-r--r--lib/Loadbars/Main.pm1092
-rw-r--r--lib/Loadbars/Shared.pm67
-rw-r--r--lib/Loadbars/Utils.pm61
6 files changed, 0 insertions, 1706 deletions
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{