CrunchBang Linux Pastebin - collaborative debugging

pastebin is a collaborative debugging tool allowing you to share and modify code snippets while chatting on IRC, IM or a message board.

This site is developed to XHTML and CSS2 W3C standards. If you see this paragraph, your browser does not support those standards and you need to upgrade. Visit WaSP for a variety of options.

CrunchBang Linux Pastebin

Posted by Bums wmiircpl on Fri 16th Mar 19:39 (modification of post by view diff)
download | new post

  1. #!/usr/bin/env perl
  2.  
  3. use strict;
  4. use warnings;
  5.  
  6. use threads;
  7.  
  8. use 5.010;
  9.  
  10. use File::Basename; # fileparse
  11. use File::Temp qw(tempfile);
  12. use IO::Socket::UNIX;
  13. use Lib::IXP qw(:subs :consts);
  14. use List::MoreUtils qw(uniq);
  15. use List::Util qw(first);
  16. use POSIX qw(setsid strftime);
  17. use Time::HiRes qw(usleep);
  18.  
  19. $SIG{CHLD} = 'IGNORE';
  20.  
  21. pipe EVENT_READ, EVENT_WRITE;
  22.  
  23. my $CLIENT;
  24.  
  25. sub ycreate {
  26.         my ($file, $data) = @_;
  27.         xcreate($CLIENT, $file, $data);
  28. }
  29.  
  30. sub yremove {
  31.         my ($file) = @_;
  32.         xremove($CLIENT, $file);
  33. }
  34.  
  35. sub ylist {
  36.         my ($dir) = @_;
  37.         map { $_->{name} } @{(xls($CLIENT, $dir))};
  38. }
  39.  
  40. sub yread {
  41.         my ($file) = @_;
  42.         xread($CLIENT, $file, -1);
  43. }
  44.  
  45. sub ywrite {
  46.         my ($file, $data) = @_;
  47.         xwrite($CLIENT, $file, $data);
  48. }
  49.  
  50. sub launch_external {
  51.         my $pid = fork();
  52.  
  53.         if (not defined $pid) {
  54.                 die 'Couldn\'t fork';
  55.         } elsif (not $pid) {
  56.                 setsid() or die 'Couldn\'t setsid';
  57.                 close(STDOUT);
  58.                 close(STDERR);
  59.                 exec(@_);
  60.                 exit;
  61.         }
  62. }
  63.  
  64. sub gen_proglist {
  65.         my $path = shift || $ENV{PATH};
  66.  
  67.         my ($proglist_fh, $proglist_file) = tempfile();
  68.         my @path = split /:/, $path;
  69.         my @progs = ();
  70.  
  71.         for my $p (@path) {
  72.                 push(@progs, map { (fileparse($_))[0] } glob("$p/*"));
  73.         }
  74.  
  75.         print $proglist_fh join("\n", sort(uniq(@progs)), '');
  76.  
  77.         return $proglist_file;
  78. }
  79.  
  80. sub all_tags {
  81.         return grep { !/^sel$/ } ylist('/tag');
  82. }
  83.  
  84. sub tagmenu {
  85.         my $tags = join('\\\\n', all_tags());
  86.         return `echo -e $tags | wimenu`;
  87. }
  88.  
  89. sub float {
  90.         if (grep {!/^select ~$/} cur_tag_info()) {
  91.                 ywrite('/tag/sel/ctl', 'select ~');
  92.         }
  93. }
  94.  
  95. sub cur_tag_info {
  96.         my $ctl = yread('/tag/sel/ctl');
  97.         return split('\n', $ctl);
  98. }
  99.  
  100. sub cur_tag {
  101.         return (cur_tag_info())[0];
  102. }
  103.  
  104. sub extract_colors {
  105.         substr(shift, 0, 23);
  106. }
  107.  
  108. sub shift_tag {
  109.         my $dir = shift;
  110.  
  111.         my @tags = all_tags();
  112.         my $cur = cur_tag();
  113.  
  114.         $tags[((first {$tags[$_] eq $cur} 0..$#tags) + $dir) % @tags];
  115. }
  116.  
  117. my @tag_stack;
  118.  
  119. sub update_tag_stack {
  120.         my ($tag) = @_;
  121.  
  122.         my @temp_stack = grep { !/^${tag}$/ } @tag_stack;
  123.         push (@temp_stack, $tag);
  124.         @tag_stack = @temp_stack;
  125. }
  126.  
  127. my $VLC_SOCK = '/tmp/vlc.sock';
  128.  
  129. sub vlc_cmd {
  130.         my ($cmd) = @_;
  131.  
  132.         my $sock = IO::Socket::UNIX->new(Peer => $VLC_SOCK) or return;
  133.         print $sock $cmd;
  134. }
  135.  
  136. ### Change current directory
  137.  
  138. chdir($ENV{HOME});
  139.  
  140. ### Set some values
  141.  
  142. my $USER = $ENV{USER};
  143. my $DISPLAY = (split(/\./, $ENV{DISPLAY}))[0];
  144. $CLIENT = "unix!/tmp/ns.$USER.$DISPLAY/wmii";
  145.  
  146. my $proglist_file = gen_proglist();
  147.  
  148. ### General configuration
  149.  
  150. my $term='urxvt';
  151.  
  152. my $normal_fg = '#ffffff';
  153. my $normal_bg = '#000000';
  154. my $normal_brd = '#444444';
  155.  
  156. my $focus_brd = '#ffffff';
  157.  
  158. my $urgent_bg = '#ff6600';
  159.  
  160. my $offline_bg = '#444444';
  161.  
  162. my $normal_colors = "$normal_fg $normal_bg $normal_brd";
  163. my $focus_colors = "$normal_fg $normal_bg $focus_brd";
  164. my $urgent_colors = "$normal_fg $urgent_bg $normal_brd";
  165. my $offline_colors = "$normal_fg $offline_bg $normal_brd";
  166.  
  167. my $battery_path = '/sys/class/power_supply/BAT1';
  168.  
  169. my %key = (
  170.         mod     => 'Mod4',
  171.         mod_alt => 'Mod1',
  172.         left    => 'h',
  173.         down    => 'j',
  174.         up      => 'k',
  175.         right   => 'l',
  176.         toggle  => 'space',
  177. );
  178.  
  179. my $loadavg_alert = 4;
  180. my $loadavg_warn = 2;
  181.  
  182. ### Init wmii
  183.  
  184. ywrite('/event', 'Start wmiirc');
  185.  
  186. ywrite('/ctl', "normcolors $normal_colors");
  187. ywrite('/ctl', "focuscolors $focus_colors");
  188. ywrite('/ctl', "grabmod $key{mod}");
  189.  
  190. ### Set up keys
  191.  
  192. my %keys = (
  193.         "$key{mod}-Return" => sub {
  194.                 launch_external($term);
  195.         },
  196.  
  197.         "$key{mod}-Shift-c" => sub {
  198.                 ywrite('/client/sel/ctl', 'kill');
  199.         },
  200.  
  201.         "$key{mod}-d" => sub {
  202.                 ywrite('/tag/sel/ctl', 'colmode sel default-max');
  203.         },
  204.         "$key{mod}-s" => sub {
  205.                 ywrite('/tag/sel/ctl', 'colmode sel stack-max');
  206.         },
  207.         "$key{mod}-m" => sub {
  208.                 ywrite('/tag/sel/ctl', 'colmode sel stack+max');
  209.         },
  210.         "$key{mod}-f" => sub {
  211.                 ywrite('/client/sel/ctl', 'Fullscreen toggle');
  212.         },
  213.  
  214.         "$key{mod}-t" => sub {
  215.                 my $result = tagmenu();
  216.                 ywrite('/ctl', "view $result");
  217.         },
  218.         "$key{mod}-Shift-t" => sub {
  219.                 my $result = tagmenu();
  220.                 ywrite('/client/sel/tags', $result);
  221.         },
  222.  
  223.         "$key{mod}-a" => sub {
  224.                 my @tags = ylist('/lbar');
  225.                 for my $tag (@tags) {
  226.                         my $colors = extract_colors(yread("/lbar/$tag"));
  227.                         if ($colors eq $urgent_colors) {
  228.                                 ywrite('/ctl', "view $tag");
  229.                                 last;
  230.                         }
  231.                 }
  232.         },
  233.  
  234.         "$key{mod}-Left" => sub {
  235.                 my $new_tag = shift_tag(-1);
  236.                 ywrite('/ctl', "view $new_tag");
  237.         },
  238.         "$key{mod}-Right" => sub {
  239.                 my $new_tag = shift_tag(+1);
  240.                 ywrite('/ctl', "view $new_tag");
  241.         },
  242.  
  243.         "$key{mod}-Tab" => sub {
  244.                 return if @tag_stack < 2;
  245.  
  246.                 my $prev_tag = $tag_stack[-2];
  247.                 ywrite('/ctl', "view $prev_tag");
  248.         },
  249.  
  250.         "$key{mod}-p" => sub {
  251.                 launch_external("\$(wimenu <$proglist_file)");
  252.         },
  253.  
  254.         "$key{mod_alt}-space" => sub {
  255.                 float();
  256.                 launch_external("$term -e alsamixer");
  257.         },
  258.  
  259.         "$key{mod}-w" => sub {
  260.                 float();
  261.                 launch_external('~/uw-weather/fetch.pl | xmessage -default okay -center -file -');
  262.         },
  263.  
  264.         'XF86AudioMute' => sub {
  265.                 launch_external('amixer set Master toggle');
  266.         },
  267.  
  268.         'XF86MonBrightnessDown' => sub {
  269.                 launch_external('setlap \'b!d\' q');
  270.         },
  271.         'XF86MonBrightnessUp' => sub {
  272.                 launch_external('setlap \'b!u\' q');
  273.         },
  274.  
  275.         'Control-Shift-Up' => sub {
  276.                 launch_external('setxkbmap -layout us');
  277.         },
  278.         'Control-Shift-Down' => sub {
  279.                 launch_external('setxkbmap -layout ru');
  280.         },
  281.  
  282.         'Print' => sub {
  283.                 launch_external('import /tmp/foo.png');
  284.         },
  285.  
  286.         'XF86AudioPlay' => sub {
  287.                 vlc_cmd('pause');
  288.         },
  289.         'Shift-XF86AudioPlay' => sub {
  290.                 vlc_cmd('play');
  291.         },
  292.         'XF86AudioStop' => sub {
  293.                 vlc_cmd('stop');
  294.         },
  295.         'XF86AudioNext' => sub {
  296.                 vlc_cmd('next');
  297.         },
  298.         'XF86AudioPrev' => sub {
  299.                 vlc_cmd('prev');
  300.         },
  301.         'Shift-XF86AudioNext' => sub {
  302.                 vlc_cmd('key key-jump+short');
  303.         },
  304.         'Shift-XF86AudioPrev' => sub {
  305.                 vlc_cmd('key key-jump-short');
  306.         },
  307. );
  308.  
  309. $keys{Caps_Lock} = $keys{"$key{mod}-t"};
  310.  
  311. for my $dir ('left', 'down', 'up', 'right', 'toggle') {
  312.         $keys{"$key{mod}-$key{$dir}"} = sub {
  313.                 ywrite('/tag/sel/ctl', "select $dir");
  314.         };
  315.         $keys{"$key{mod}-shift-$key{$dir}"} = sub {
  316.                 ywrite('/tag/sel/ctl', "send sel $dir");
  317.         };
  318. }
  319.  
  320. for my $tag (0..9) {
  321.         $keys{"$key{mod}-$tag"} = sub {
  322.                 ywrite('/ctl', "view $tag");
  323.         };
  324.         $keys{"$key{mod}-Shift-$tag"} = sub {
  325.                 ywrite('/client/sel/tags', $tag);
  326.         };
  327. }
  328.  
  329. ywrite('/keys', join("\n", keys %keys) . "\n");
  330.  
  331. ### Set up statuses
  332.  
  333. my @statuses = (
  334.         sub { # spacer
  335.         },
  336.         sub { # speakers
  337.                 my $bar = "/rbar/$_[0]";
  338.                 for (;;) {
  339.                         my ($volume, $on);
  340.  
  341.                         open(MIXER, 'amixer get Master |');
  342.                         while (<MIXER>) {
  343.                                 if (/front left:.*?\[(-?[\d.]+)dB\].*?\[(o[fn]+)\]/i) {
  344.                                         ($volume, $on) = ($1, $2 ne 'off');
  345.                                         last;
  346.                                 }
  347.                         }
  348.                         close(MIXER);
  349.  
  350.                         my $colors;
  351.                         if ($on) {
  352.                                 $colors = sprintf("$normal_fg #0000%02x $normal_brd", int(255 * (46.5 + $volume) / 46.5));
  353.                         } else {
  354.                                 $colors = $offline_colors;
  355.                         }
  356.  
  357.                         ywrite($bar, "$colors ${volume} dB");
  358.                         usleep(2_000_000);
  359.                 }
  360.         },
  361.         sub { # load average
  362.                 my $bar = "/rbar/$_[0]";
  363.                 for (;;) {
  364.                         open(LOADAVG, '/proc/loadavg');
  365.                         my $la = (split(' ', <LOADAVG>))[0];
  366.                         close(LOADAVG);
  367.  
  368.                         my $colors;
  369.                         if ($la > $loadavg_alert) {
  370.                                 $colors = "$normal_fg #ff0000 #ff0000";
  371.                         } elsif ($la > $loadavg_warn) {
  372.                                 my $bg_r = int(255 * ($la - $loadavg_warn) / ($loadavg_alert - $loadavg_warn));
  373.                                 $colors = sprintf("$normal_fg #%02x0000 $normal_brd", $bg_r);
  374.                         } else {
  375.                                 $colors = $normal_colors;
  376.                         }
  377.  
  378.                         ywrite($bar, "$colors $la");
  379.                         usleep(5_000_000);
  380.                 }
  381.         },
  382.         sub { # backlight
  383.                 my $bar = "/rbar/$_[0]";
  384.                 for (;;) {
  385.                         open(BACKLIGHT, '/sys/class/backlight/acpi_video0/brightness');
  386.                         my $brightness = <BACKLIGHT>;
  387.                         close(BACKLIGHT);
  388.  
  389.                         ywrite($bar, "b$brightness");
  390.                         usleep(1_000_000);
  391.                 }
  392.         },
  393.         sub { # cpu temp
  394.                 my $bar = "/rbar/$_[0]";
  395.                 for (;;) {
  396.                         open(CPU_TEMP, '/sys/class/thermal/thermal_zone0/temp');
  397.                         my $temp = <CPU_TEMP> / 1000;
  398.                         close(CPU_TEMP);
  399.  
  400.                         my $colors;
  401.                         if ($temp > 75) {
  402.                                 $colors = "$normal_fg #ff0000 #ff0000";
  403.                         } elsif ($temp >= 55) {
  404.                                 my $bg_r = int(255 * ($temp - 55) / 20);
  405.                                 $colors = sprintf("$normal_fg #%02x0000 $normal_brd", $bg_r);
  406.                         } else {
  407.                                 $colors = $normal_colors;
  408.                         }
  409.  
  410.                         ywrite($bar, "$colors $temp C");
  411.                         usleep(1_000_000);
  412.                 }
  413.         },
  414.         sub { # battery
  415.                 my $bar = "/rbar/$_[0]";
  416.                 for (;;) {
  417.                         if (-e $battery_path) {
  418.                                 open(BATTERY, "$battery_path/status");
  419.                                 my $status = <BATTERY>;
  420.                                 open(BATTERY, "$battery_path/energy_now");
  421.                                 my $now = <BATTERY>;
  422.                                 open(BATTERY, "$battery_path/energy_full");
  423.                                 my $full = <BATTERY>;
  424.                                 close(BATTERY);
  425.  
  426.                                 my $ratio = $now / $full;
  427.  
  428.                                 my $border;
  429.                                 given ($status) {
  430.                                         when (/^charging/i) { $border = '#00ff00' };
  431.                                         when (/^full/i)     { $border = $normal_brd };
  432.                                         default             { $border = '#ff0000' };
  433.                                 }
  434.  
  435.                                 my $bg_r = int(255 * (1 - $ratio));
  436.  
  437.                                 ywrite($bar, sprintf("$normal_fg #%02x0000 $border %.3f%%", $bg_r, 100 * $ratio));
  438.                         } else {
  439.                                 ywrite($bar, "$offline_colors ???%");
  440.                         }
  441.                         usleep(5_000_000);
  442.                 }
  443.         },
  444.         sub { # time
  445.                 my $bar = "/rbar/$_[0]";
  446.                 for (;;) {
  447.                         ywrite($bar, strftime('%d %a %H:%M:%S', localtime));
  448.                         usleep(500_000);
  449.                 }
  450.         },
  451. );
  452.  
  453. ### Set up lbar for existing tags
  454.  
  455. yremove("/lbar/$_") for ylist('/lbar');
  456.  
  457. my $cur_tag = cur_tag();
  458. for my $tag (all_tags()) {
  459.         if ($tag eq $cur_tag) {
  460.                 ycreate("/lbar/$tag", "$focus_colors $tag");
  461.         } else {
  462.                 ycreate("/lbar/$tag", "$normal_colors $tag");
  463.         }
  464. }
  465.  
  466. ### And get the statuses going
  467.  
  468. yremove("/rbar/$_") for ylist('/rbar');
  469.  
  470. for my $status (0..$#statuses) {
  471.         ycreate("/rbar/$status", '');
  472.  
  473.         my $thr = threads->create($statuses[$status], $status);
  474.         $thr->detach();
  475. }
  476.  
  477. ### Event loop!
  478.  
  479. my $event_child = fork();
  480.  
  481. if (not defined $event_child) {
  482.         die 'Couldn\'t fork';
  483. } elsif (not $event_child) {
  484.         # Since /event doesn't get EOF until wmii exits, this hangs forever.
  485.         xread($CLIENT, '/event', fileno(EVENT_WRITE));
  486.         exit; # But just in case.
  487. }
  488.  
  489. END {
  490.         # Kill the child that has the xread call for /event
  491.         kill(9, $event_child);
  492. }
  493.  
  494. while (<EVENT_READ>) {
  495.         if (/^Start wmiirc$/) {
  496.                 last;
  497.  
  498.         } elsif (/^Key (.*)$/) {
  499.                 if (defined $keys{$1}) {
  500.                         $keys{$1}();
  501.                 }
  502.         } elsif (/^CreateTag (.*)/) {
  503.                 ycreate("/lbar/$1", "$normal_colors $1");
  504.         } elsif (/^DestroyTag (.*)/) {
  505.                 yremove("/lbar/$1");
  506.         } elsif (/^FocusTag (.*)/) {
  507.                 update_tag_stack($1);
  508.                 ywrite("/lbar/$1", "$focus_colors $1");
  509.         } elsif (/^UnfocusTag (.*)/) {
  510.                 ywrite("/lbar/$1", "$normal_colors $1");
  511.         } elsif (/^UrgentTag [^ ]+ (.*)/) {
  512.                 if (cur_tag() ne $1) {
  513.                         ywrite("/lbar/$1", "$urgent_colors $1");
  514.                 }
  515.         } elsif (/^NotUrgentTag [^ ]+ (.*)/) {
  516.                 if (cur_tag() ne $1) {
  517.                         ywrite("/lbar/$1", "$normal_colors $1");
  518.                 }
  519.         } elsif (/^LeftBarMouseDown \d+ (.*)/) {
  520.                 ywrite('/ctl', "view $1");
  521.         }
  522. }

Submit a correction or amendment below (click here to make a fresh posting)
After submitting an amendment, you'll be able to view the differences between the old and new posts easily.

Syntax highlighting:

To highlight particular lines, prefix each line with @@


Remember me