SoundOff Program (eg. for Pandora Radio)

[liverpole]

When I listen to soft jazz on Pandora Radio at work, I like to mute the volume when the advertising starts so I can concentrate on what I'm doing.

The problem is, when I'm in the middle of a software task I often forget to unmute the volume, so a period of time goes by before I realize I'm still "listening" to the radio.

This simple app is my lazy way to avoid having to turn on the volume again. I can click on the big green On/Off button (or type "Enter") and the speaker volume goes off for a preset time (15-seconds by default; typically long enough for most ads), and then automatically unmutes when the interval expires.

There's a volume control slider, as well as the capability to disable the timer altogether, making the unmute operation manual instead.

The program works on Windows, and requires installation of the perl/Tk module and Win32::Sound.

Though it's pretty straightforward, you can always click on 'F1' for help.

Edit:  I discovered there's a bug in Win32::Sound, whereby setting the volume disables the right speaker. I've edited the code to add the workaround, change tabs to spaces, and remove a couple of focusNext perl/Tk calls which were unnecessary.

#!/usr/bin/perl -w


###############
## Libraries ##
###############
use strict;
use warnings;
use Tk;
use Tk::Font;
use Tk::Photo;
use Tk::ROText;
use Tk::DialogBox;
use Win32::Sound;


##################
## User-defined ##
##################
my $prog_title  = "SoundOff v1.0 -- Dec. 2011 by John C. Norton";
my $min_mute    = 5;
my $dflt_mute   = 15;

# GUI Look & Feel
my $a_timer_bg   = [ '#ffafef', '#ffbf7f' ];
my $a_timer_txt  = [ 'Timer Inactive (Esc)', 'Timer Active (Esc)' ];
my $bg_button    = '#afcfff';
my $bg_label     = '#ffbf7f';
my $bg_meter     = '#ffdf3f';
my $bg_help      = '#cfff9f';
my $fo_slider    = 'Lucida Sans:9/*';
my $fo_button    = 'Comic Sans MS:10*';
my $fo_label     = 'Arial:10*';
my $fo_help      = 'Lucida Sans:8';
my $a_can_geo    = [ 128, 256 ];
my $a_meter_x    = [ 48,  90  ];
my $a_meter_y    = [ 32,  220 ];
my $a_bg_meter   = [ '#ffffcf', '#ff3f3f' ];
my $a_btn_geo    = [ 280, 317, 3 ];
my $a_on_off_geo = [ 280, 317, 3 ];
my $h_on_xpm     = { '0' => '#7fcf7f', '2' => '#000000', '1' => '#87f7
+17' };
my $h_off_xpm    = { '0' => '#ffbf7f', '2' => '#000000', '1' => '#ff3f
+3f' };


#############
## Globals ##
#############
my $volume    = '100';
my $b_resume  = 1;
my $b_mute    = 0;
my $c_tick    = 0;
my $mute_time = my $resume = $dflt_mute;
my ($btn_on, $btn_off, $cv_meter, $id_meter, $id_text, $mute_ent, $c_t
+imer);


##################
## Main Program ##
##################
create_gui();


#################
## Subroutines ##
#################
sub create_gui {
    my $mw   = new MainWindow(-title => $prog_title);
    my $fr1  = frame($mw, '^0x');   # Help, Master Volume, Quit
    my $fr2  = frame($mw, '^1b');   # Main frame
    my $fr3  = frame($fr2, '<0b');  # Large On/Off button
    my $fr4  = frame($fr2, '<1b');  # Timer Active, Mute Time, Meter

    main_options($fr1);

    $btn_on   = sound_on_button($fr3);
    $btn_off  = sound_off_button($fr3);
    $c_timer  = togglebtn($fr4, \$b_resume, $a_timer_txt, $a_timer_bg)
+;
    lbl_entry($fr4, 'Mute Time', \$mute_time);
    resume_meter($fr4);

    my $c_idle = sub { ($b_mute and $b_resume and $c_tick) and $c_tick
+->(1) };
    $mw->repeat(1000 => $c_idle);
    MainLoop;
}


sub main_options {
    my ($w) = @_;

    my $mw  = $w->toplevel;
    my $fr1 = frame($w, '<0bg1');
    my $fr2 = frame($w, '<1xg1');
    my $fr3 = frame($w, '>0bg1');

    my $b1  = button($fr1, 'Help (F1)', '<1b');
    my $b2  = button($fr3, 'Quit (^Q)', '<1b');

    volume_slider($fr2);

    $b1->configure(-command => sub { give_help($mw) });
    $b2->configure(-command => sub { exit });

    $mw->bind("<F1>"              => sub { $b1->invoke });
    $mw->bind("<Control-q>"       => sub { $b2->invoke });
    $mw->bind("<Return>"          => sub { toggle_mute() });
    $mw->bind("<KeyPress-Left>"   => sub { adjust_mute_time(-5) });
    $mw->bind("<KeyPress-Right>"  => sub { adjust_mute_time(5)  });
    $mw->bind("<KeyPress-Down>"   => sub { adjust_volume('-') });
    $mw->bind("<KeyPress-Up>"     => sub { adjust_volume('+')  });
    $mw->bind("<Escape>"          => sub { $c_timer->() });
}


sub resume_meter {
    my ($w) = @_;
    $cv_meter = $w->Canvas(-bg => 'gray', -takefocus => 0);
    $cv_meter->configure(-width  => $a_can_geo->[0]);
    $cv_meter->configure(-height => $a_can_geo->[1]);
    my ($x0, $x1, $y0, $y1) = ( @$a_meter_x, @$a_meter_y );
    my @rect = ( $x0, $y0, $x1, $y1, -fill => $a_bg_meter->[0] );
    $cv_meter->createRectangle(@rect);
    packit($cv_meter, '1bg2');
}


sub volume_slider {
    my ($w) = @_;
    my $a_vol = [ '-orient' => 'horizontal', -label => '~ Master Volum
+e ~' ];
    my $vol   = $w->Scale(@$a_vol, -variable => \$volume, -bg => $bg_m
+eter);
    $vol->configure(-command => [ \&adjust_volume, '*' ]);
    $vol->configure(-takefocus => 0, -font => create_font($w, $fo_slid
+er));
    packit($vol, '<1b');
}


sub adjust_mute_time {
    my ($incr) = @_;
    $mute_time =~ s/\D//g;
    $mute_time ||= $dflt_mute;
    ($incr eq '*') and $incr = 0;
    $mute_time += $incr;
    ($mute_time < $min_mute) and $mute_time = $min_mute;
    return $mute_time;
}


sub button {
    my ($w, $text, $pack) = @_;
    my $btn  = $w->Button(-bg => $bg_button, -text => $text, -takefocu
+s => 0);
    $btn->configure(-font => create_font($w, $fo_button));
    return packit($btn, $pack || '<');
}


sub create_font {
    my ($w, $font_spec) = @_;
    my $weight = ($font_spec =~ s/[*]//)? 'bold':   'normal';
    my $slant  = ($font_spec =~ s:[/]::)? 'italic': 'roman';
    my ($fam, $size, $bold) = $font_spec =~ /(.+):(\d+)([*])?$/;
    my $mw     = $w->toplevel;
    my @args   = ( -weight => $weight, -slant => $slant );
    my $font = $mw->Font(-family => $fam, -size => $size, @args);
    return $font;
}


sub lbl_entry {
    my ($w, $label, $s_var) = @_;
    my $frm   = frame($w, '0xg2');
    my $lbl   = $frm->Label(-bg => $bg_label, -text => $label);
    $lbl->configure(-font => create_font($w, $fo_label));
    $mute_ent = $frm->Entry(-width => 1, -justify => 'center');
    my $c_validate = sub { return ($_[0] =~ /^\d*$/)? 1: 0 };
    $mute_ent->configure(-textvar => $s_var);
    $mute_ent->configure(-validate => 'all', -validatecommand => $c_va
+lidate);
    $lbl->pack($mute_ent, -side => 'left');
    $mute_ent->pack(-expand => 1, -fill => 'both');
    $mute_ent->focus;
    $mute_ent->selectionRange(0, 15);
}


sub togglebtn {
    my ($w, $s_var, $a_text, $a_bg) = @_;

    my $frm  = frame($w, '0xg2');
    my $btn  = $frm->Button();

    my $c_toggle = sub {
        my $text = $a_text->[$$s_var = 1 - $$s_var];
        my $bg   = $a_bg->[$$s_var];
        $btn->configure(-text => $text, -bg => $bg);
    };

    $btn->configure(-text => $a_text->[$$s_var], -bg => $a_bg->[$$s_va
+r]);
    $btn->configure(-command => $c_toggle, -takefocus => 0);
    $btn->configure(-font => create_font($w, $fo_button));
    packit($btn, '1b');
    return $c_toggle;
}


sub frame {
    my ($w, $pack, $bg) = @_;
    my $frm = $w->Frame;
    ($bg || "") and $frm->configure(-bg => $bg);
    return packit($frm, $pack);
}


sub packit {
    my ($w, $pack) = @_;
    $pack ||= '^0n';

    my $h_sides = {qw{ < left > right ^ top v bottom}};
    my $h_fill  = {qw{n none b both x x y y }};
    my $h_rel   = {qw{ - flat g groove r ridge s solid ^ raised v sunk
+en }};
    my $side    = ($pack =~ s/^([<v^>])//)?   $h_sides->{$1}: 'top';
    my $b_exp   = ($pack =~ s/^([01])//)?     $1:             0;
    my $fill    = ($pack =~ s/^([nbxy])//)?   $h_fill->{$1}:  'none';
    my $rel     = ($pack =~ s/^([-grs^v])//)? $h_rel->{$1}:   '';
    my $bw      = ($pack =~ s/^(\d+)//)?      $1:             2;

    $rel and $w->configure(-relief => $rel, -borderwidth => $bw);
    $w->pack(-expand => $b_exp || 0, -fill => $fill, -side => $side);
}


sub toggle_mute {
    my ($btn) = @_;
    return ($b_mute = 1 - $b_mute)? mute_on(): mute_off();
}


sub mute_on {
    adjust_volume(0);
    $btn_on->packForget;
    $btn_off->pack;
    $resume = my $curr_mute = adjust_mute_time(0);
    $b_mute = 1;

    $c_tick = sub {
        my ($nsecs) = @_;
        $resume -= $nsecs;
        ($resume <= 0) and return mute_off();
        my $pcnt = (100 * $resume / $curr_mute);
        meter_level($pcnt);
        meter_label($resume);
    };

    $c_tick->(0);
}


sub mute_off {
    $resume = $mute_time || $dflt_mute;
    $btn_on->pack;
    $btn_off->packForget;
    meter_level(0);
    meter_label('On');
    $b_mute = $c_tick = 0;
    adjust_volume('*');
}


sub meter_level {
    my ($pcnt) = @_;
    $pcnt = 100 - $pcnt;
    my ($x0, $x1, $y0, $y1) = ( @$a_meter_x, @$a_meter_y );
    $y0 += ($pcnt * ($y1 - $y0)) / 100;
    my @rect  = ( $x0, $y0, $x1, $y1, -fill => $a_bg_meter->[1] );
    $id_meter and $cv_meter->delete($id_meter);
    $id_meter = $cv_meter->createRectangle(@rect);
}


sub meter_label {
    my ($text) = @_;
    my ($x0, $x1, $y0, $y1) = ( @$a_meter_x, @$a_meter_y );
    my ($textx, $texty) = (($x0 + $x1) / 2, $y1 + 4);
    my @args = ( $textx, $texty, -anchor => 'n', -text => $text);
    $id_text and $cv_meter->delete($id_text);
    $id_text = $cv_meter->createText(@args);
}


sub adjust_volume {
    my ($vol) = @_;
    ($vol eq '*') and $vol = $volume;
    ($vol eq '-') and $vol = ($volume > 0)?   --$volume: $volume;
    ($vol eq '+') and $vol = ($volume < 100)? ++$volume: $volume;
    if (0 == $vol or !$b_mute) {
        my $val = int(65535 * $vol / 100) & 0x0000ffff;
        Win32::Sound::Volume(($val << 16) | $val);
       }
}


sub create_xpm {
    my ($a_geo, $h_xpm, $data) = @_;

    my ($w, $h, $nsyms) = @$a_geo;
    my ($lb, $rb)       = (chr(123), chr(125));  # Don't mess up '%' i
+n vim

    # Create XPM header
    my $xpm = qq{
        :/* XPM */
        :static char *xpm[] = $lb
        :"$w $h $nsyms 1",
    };

    # Fill in XPM color symbols
    foreach my $key (keys %$h_xpm) {
        my $line = sprintf "%s c %s", $key, $h_xpm->{$key};
        $xpm .= qq{\n\t\t:"$line",};
    }
    $xpm =~ s/(^\s+:)|((?<=\n)\s+:)|(\s+$)//g;

    my $c_dec = sub {
        my $N = ord($_[0]);
        return 126 == $N? 0: 124 == $N? 75: $N < 92? $N-17: $N-92;
    };

    # Decode XPM data
    $data     =~ s/(^[^:]+:)|((?<=\n)\s+(?=:))|(:[^:]+$)//gs;
    $data     =~ s/:\n://g;
    my $nhuff = $c_dec->(substr($data, 0, 1, ""));
    my $size  = $c_dec->(substr($data, 0, 1, ""));

    for (my $i = 0; $i < $nhuff; $i++) {
        my $sym = substr($data, 0, $size, "");
        my $rep = substr($data, 0, 1, "");
        $data =~ s/\Q$rep\E/$sym/g;
    }

    substr($data, 0, $c_dec->(substr($data, 0, 1, "")), "");

    my $decode = "";
    while ($data) {
        my $symbol    = substr($data, 0, 1, "");
        my ($b1, $b2) = substr($data, 0, 2, "") =~ /^(.)(.)$/;
        $decode .= $symbol x (76 * $c_dec->($b1) + $c_dec->($b2));
    }

    # Merge XPM header and data
    for (my $i = 1; $i <= $h; $i++) {
        my $line = substr($decode, 0, $w, "");
        $xpm .= qq{\n"$line"} . (($i < $h)? ",": "$rb;");
    }

    return $xpm;
}


sub sound_on_button {
    my ($w) = @_;
    my $data = on_off_data();
    my $xpm  = create_xpm($a_on_off_geo, $h_on_xpm, $data);
    my $btn  = image_button($xpm, $w);
    $btn->configure(-command => \&toggle_mute);
    return packit($btn);
}


sub sound_off_button {
    my ($w) = @_;
    my $data = on_off_data();
    my $xpm  = create_xpm($a_on_off_geo, $h_off_xpm, $data);
    my $btn  = image_button($xpm, $w);
    $btn->configure(-command => \&toggle_mute);
    return $btn;
}


sub image_button {
    my ($xpm, $w) = @_;
    my $mw  = $w->toplevel;
    my $img = $mw->Photo(-format => 'xpm', -data => $xpm);
    my $btn = $w->Button();
    $btn->configure(-image => $img, -takefocus => 0);
    return $btn;
}


sub give_help {
    my ($mw) = @_;
    my $title = "Help Menu";
    my $db  = $mw->DialogBox(-title => $title, -buttons => [ "Dismiss"
+ ]);
    my $frm = $db->add('Frame');
    packit($frm, '0xr4');
    my $text = qq{
        :
        : ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        : SoundOff is a simple Windows application that mutes the comp
+uter
        : speaker for a given timer interval, after which the volume i
+s
        : automatically restored (unless the timer is inactive).
        :
        : The modules 'Tk' and 'Win32::Sound' are both required.
        :
        : The following features exist:
        :
        :   1.  Help button (or F1)
        :
        :       Displays this help menu.  (Same as the <F1> key).
        :
        :   2.  Master Volume slider (or <Up Arrow> and <Down Arrow>)
        :
        :       Selects the speaker volume when unmuted.  The keyboard
        :       accelerator keys <Up Arrow> and <Down Arrow> may be us
+ed
        :       to respectively raise or lower the volume.
        :
        :   3.  Quit button (or ^Q)
        :
        :       Exits the program.  (Same as the <Control-Q> key).
        :
        :   4.  Speaker Off/On Button (or <Enter>)
        :
        :       Mutes or unmutes the speaker for the duration of the
        :       current Mute Time.  The <Enter> key does the same thin
+g.
        :
        :   5.  Timer Active button (or <Escape>)
        :
        :       Disables the timer so the speaker is not automatically
        :       unmuted, even after the mute time interval has elapsed
+.
        :       This lets the user mute/unmute the speaker manually.
        :       The <Escape> key can be used as a shortcut for this.
        :
        :   6.  Mute Time (or <Left Arrow> and <Right Arrow>)
        :
        :       Selects the exact number of seconds after which the sp
+eaker
        :       volume is restored.  The <Left Arrow> and <Right Arrow
+> keys
        :        respectively subtract or add 5-second intervals to th
+e time.
        :
        :   7.  Progress meter
        :
        :       A meter which displays a visual indication of the numb
+er
        :       of seconds left until the speaker is unmuted.
        : ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
        : $prog_title
    };
    $text =~ s/(^\s+:)|((?<=\n)\s+:)|(\s+$)//g;
    my @text = split /\n/, $text;
    my @dim  = ( -width => 64, -height => 1 + @text );
    my $txt  = $db->add('ROText', -bg => $bg_help, @dim);
    packit($txt, '1b');
    $txt->configure(-font => create_font($mw, $fo_help));
    map { $txt->insert('end', "     $_\n") } @text;
    $txt->see('end');
    $db->Show;
}


sub on_off_data {
    return q{
        :l^0~ ~t!1~"1^#~r$~s%0]&1_'`2(1])0_*~q+x2,b2-~u.~2/_1020eg2~f*
+92~:
        :j*62~l*42~n*22~p*02$*z2$*y2!*,!*,!*,!*,!*,!*,!*,!*,!*,!*,!*,!
+*,!:
        :*,!*,!*,!*,!*,!*,!*,!*,!*,!*,!*,!*,!*,!*,!*,!*,!*,!*v"^2!"^*k
+"g2:
        :!"g*]"l2!"l0^T"q2!"q0^K"u2!"u0^D",!"x0^>"02!"00^8"32!"30^22~c
+"z2:
        :!"z2~c0^,~g",!",~g0^s2~k"w2!"w2~k0^n2~n"v2!"v2~n0^j2+"u2!"u2+
+0^f:
        :2!1!2!1!2!0^-~v1!2!1!2~v0^^2~y"s2!"s2~y&[2~0"s2!"s2~0&W2/"s2!
+"s2:
        :/&S2~4"s2!"s2~4&O2~6"s2!"s2~6&L2~7"s2!"s2~7&I2~9"s2!"s2~9&F2~
+91!:
        :2!1!2~9&C2~;1!2!1!2~;&@2~;"u2!"u2~;&=2~<"v2!"v2~<&:2~<"w2!"w2
+~<&:
        :72~=",!",~=&42~<"z2!"z2~<&22~;"12!"12~;&z2~;"32!"32~;&w2~;"42
+!"4:
        :2~;&u2~:"62!"62~:&s2~9"82!"82~9&q2~8":2!":2~8&o2~7"<2!"<2~7&m
+2~6:
        :">2!">2~6&k2~6"?2!"?2~6&h2~6"A2!"A2~6&e2~6"B2!"B2~6&c2~5"D2!"
+D2~:
        :5&a2~5"E2!"E2~5&(~3"G2!"G2~3&_2~3"H2!"H2~3&]2/"J2!"J2/ |2/"K2
+!"K:
        :2/ Z2/"L2!"L2/ X2~1"N2!"N2~1 V2~1"O2!"O2~1 T2~1"P2!"P2~1 R2~1
+"Q2:
        :!"Q2~1 Q2~0"R2!"R2~0 P2~0"S2!"S2~0 N2~0"T2!"T2~0 L2~0"U2!"U2~
+0 K:
        :2~y"W2!"W2~y J2~y"X2!"X2~y H2~z"X2!"X2~z G2~y"Y2!"Y2~y F2~y"Z
+2!":
        :Z2~y D2~y"[2!"[2~y C2~x"|2!"|2~x B2~x)/!)/~x @2~x)]2!)]2~x ?2
+~w):
        :^2!)^2~w >2~w)_2!)_2~w <2~x)_2!)_2~x ;2~w)a2$)a2~w :2~w)-$)-~
+w 9:
        :2~v)d2~p)d2~v 82~w)e2~n)e2~w 72~v)g2~l)g2~v 62~v)i2~j)i2~v 52
+~v):
        :k2~f)k2~v 42~v#;2~v 32.#=2. 22~v#=2~v 12.#?2. 02.#A2. z2.#A2.
+ y2:
        :.#C2. ,!#E2! w2.#E2. v2!#G2! u2.#G2. t2!#I2! t2!#I2! s2!#K2! 
+r2!:
        :#K2! q2!#M2! p2!#M2! p2%#O2% o2!#O2! n2!#O2! n2%#Q2% m2!#Q2! 
+l2%:
        :#S2% l2%#S2% k2!#S2! j2%#U2% j2%#U2% i2!#U2! h2%#W2% h2%#W2% 
+h2%:
        :#W2% g2%#Y2% f2%#Y2% f2%#Y2% f2$#[2$ f2$#[2$ e2%#[2% d2%#[2% 
+d2$:
        :'/$ d2$'/$ d2$'/$ c2%'/% -%'/% -$'^2$ -$'^2$ -$'^2$ -$'^2$ -$
+'^2:
        :$ -+'(+ -+'(+ a2$'($ ($'($ ($'($ ($'($ ($'($ ($'($ ($'($ (+'-
++ (:
        :+'-+ (+'-+ (+'-+ (+'-+ (+'-+ (+'-+ (+'-+ (+'-+ (+'-+ (+'-+ (+
+'-+:
        : (+'-+ (+'-+ ($'($ ($'($ ($'($ ($'($ ($'($ ($'($ ($'($ a2+'(+
+ -+:
        :'(+ -$'^2$ -$'^2$ -$'^2$ -$'^2$ -$'^2$ -%'/% -%'/% c2$'/$ d2$
+'/$:
        : d2$'/$ d2%#[2% d2%#[2% e2$#[2$ f2$#[2$ f2%#Y2% f2%#Y2% f2%#Y
+2% :
        :g2%#W2% h2%#W2% h2%#W2% h2!#U2! i2%#U2% j2%#U2% j2!#S2! k2%#S
+2% :
        :l2%#S2% l2!#Q2! m2%#Q2% n2!#O2! n2!#O2! o2%#O2% p2!#M2! p2!#M
+2! :
        :q2!#K2! r2!#K2! s2!#I2! t2!#I2! t2.#G2. u2!#G2! v2.#E2. w2!#E
+2! :
        :,.#C2. y2.#A2. z2.#A2. 02.#?2. 12~v#=2~v 22.#=2. 32~v#;2~v 42
+~v#:
        :92~v 52~v#92~v 62~v#72~v 72~w#52~w 82~v#52~v 92~w#32~w :2~w#1
+2~w:
        : ;2~x#z2~x <2~w#z2~w >2~w#,~w ?2~x#v2~x @2~x#t2~x B2~x#r2~x C
+2~y:
        :#p2~y D2~y#n2~y F2~y#l2~y G2~z#j2~z H2~y#j2~y J2~y#h2~y K2~0#
+d2~:
        :0 L2~0#-~0 N2~0#(~0 P2~0#^2~0 Q2~1#/~1 R2~1)[2~1 T2~1)Y2~1 V2
+~1):
        :W2~1 X2/)S2/ Z2/)Q2/ |2/)O2/&]2~3)K2~3&_2~3)I2~3&(~5)E2~5&a2~
+5)C:
        :2~5&c2~6)?2~6&e2~6)=2~6&h2~6)92~6&k2~6)72~6&m2~7)32~7&o2~8)z2
+~8&:
        :q2~9)v2~9&s2~:)r2~:&u2~;)n2~;&w2~=)h2~=&z2~=)d2~=&22~?)^2~?&4
+2~A:
        :"Y2~A&72~B"S2~B&:2~D"M2~D&=2~F"E2~F&@2~J";2~J&C2~M"12~M&F2~U"
+j2~:
        :U&I2]W&L2]U&O2]Q&S2]M&W2]I&[2]E0^^2]A0^-]=0^f2]90^j2]50^n2]10
+^s2:
        :]v0^,]r0^22]l0^82]f0^>2]`0^D2~[0^K2~S0^T2~I*]2~?*k2~x0e^:
    };
}

[jwkrahn]

    my $xpm = qq{
        :/* XPM */
        :static char *xpm[] = $lb
        :"$w $h $nsyms 1",
    };

    # Fill in XPM color symbols
    foreach my $key (keys %$h_xpm) {
        my $line = sprintf "%s c %s", $key, $h_xpm->{$key};
        $xpm .= qq{\n\t\t:"$line",};
    }
    $xpm =~ s/(^\s+:)|((?<=\n)\s+:)|(\s+$)//g;

Why add the leading whitespace and colon when you are just going to remove them anyway?

And the substitution would be more efficient as:

    $xpm =~ s/^\s+://mg;
    $xpm =~ s/\s+$//;

Or at least don't use unneeded capturing parentheses:

    $xpm =~ s/(?:^\s+:)|(?:(?<=\n)\s+:)|(?:\s+$)//g;

[liverpole]

    Why add the leading whitespace and colon when you are just going to remove them anyway?

Because it's far more easy to visually parse when it's indented, and I use that formatting trick in other programs, where I sometimes have to hand-edit the text, and it's much easier when the line begins with ':' than without.

    And the substitution would be more efficient as..."

So what? It's in the startup code so it's not a performance hit, and I think the "unneeded" capturing parentheses makes it easier to read. But, yeah, thanks for "enlightening" me on regular expressions.

Honestly, I posted this because I thought it might be useful to a few others besides me, not because I needed the code nit-picked for insignificant optimization. Did you even run it? Or was this just a chance to show off your ikegami-like superiority? It's your type of comments that make me tired and sad that I even post here any more.

[Tux]

I did something similar, and talked about that in Belfast on YAPC::EU-2004. Maybe you can pick up some ideas to extend your script. Listening to music you like during work certainly improves both work and motivation :)

My "radio" followed the playlist on the website of the station that was playing, and noted all song-switches. It then used a database with my song-ratings and modified the volume. If I had rated a song a 10, the volume went up, if I rated it 2 the volume was turned down. If a song started that I rated 1 or less, it switched stations.

The interface also allowed ratings for new songs (it displayed the rating if available) and then stored the rating in the database. I still have that database:

$ ratings.pl
Low ratings:
|  1   64 groups,  492 songs
|  2   90 groups,  319 songs
|  3   76 groups,   95 songs
|  4   55 groups,   62 songs
|     202 groups,  968 songs

Medium ratings:
|  5   42 groups,   42 songs
|  6   52 groups,   56 songs
|      92 groups,   98 songs

High ratings:
|  7  152 groups,  196 songs
|  8  240 groups,  403 songs
|  9  137 groups,  431 songs
| 10   40 groups,  150 songs
|     415 groups, 1180 songs

Total:
|     710 groups, 2246 songs

Avarage rate: 5.4

I meanwhile skipped to two stations that fit my taste better and seldom need switching. (I still have to switch when either one is off-line). Both these stations now send title and performer in the stream, so I don't have to follow websites anymore. GStreamer gives me that info while playing. As xmms is dead, I also no longer use that, but a handcrafted radio.pl written in perl/Tk.

[osbosb]

You could do this too

http://6xq.net/projects/pianobar/

[hbm]

Nice. I had the same idea when ads came out (what Pandora listener didn't, I suppose), but I just kinda stopped listening.

I look forward to trying this.

(It's odd, thinking of you as John C. Norton now, and not simply liverpole...)