http://www.perlmonks.org?node_id=1084667

Hello, everyone.

Please permit my incorrect or poor english.

I saw many Indicator Applet for Ubuntu Unity. Almost all Applet-s are made by Python. I do not see Applet by perl, yet. So, i made Indicator Applet by Gtk2-perl of Launcher.

These are a program and a need file. Please refer for details: http://www.eonet.ne.jp/~toskanosu/

#! /usr/bin/perl
#
# Copyright 2014 toskanosu (2014.04.23-05.01 run-perl.pl as /usr/local
+/bin/run-perl)
# (This is a perl Indicator Applet) (ubuntu Unity libappindicator)
#
# AUTO menu update is not implemented for Run_Any_File modified, but m
+anualy.
#
use strict; use warnings;
use Gtk2 '-init';
use Glib qw/TRUE FALSE/;
use English; use utf8; use Encode; use Cwd;
use Gtk2::AppIndicator; # libgtk2-appindicator-perl installed by Synap
+tic
my $HOME=$ENV{"HOME"};
my $USER=$ENV{"USER"};
my $Run_Any_File = $HOME."/.run-any"; # you can change contents in thi
+s file.
my $Myself_Icon="/usr/share/ubuntu-tweak/pixmaps/emblem-ohno.png"; # y
+ou can change as you like.
my $White = Gtk2::Gdk::Color->new (0xFFFF,0xFFFF,0xFFFF);
my $Red   = Gtk2::Gdk::Color->new (0xFFFF,0,0);
my (@Head,@Body,@Kind,$AppIndicator,$ImageMenuItem);
sub Trim { my $v = shift; $v =~ s/^\s*(.*?)\s*$/$1/; return $v; }
sub Left { return substr($ARG[0],0,$ARG[1]); }
sub IsIt { return index($ARG[0],$ARG[1]) > -1 }
sub Make_About {
    my $AboutDialog=Gtk2::AboutDialog->new;
    $AboutDialog->set_program_name('run-perl');
    $AboutDialog->set_comments("Indicator Applet made by perl.\n".
                               "Menu Launcher mde by toskanosu.");
    $AboutDialog->set_website('http://www.eonet.ne.jp/~toskanosu/');
    $AboutDialog->signal_connect(response => sub { $AboutDialog->destr
+oy });
    $AboutDialog->show_all;
}
sub Get_Kind {
    my $Body=shift; return(0) if $Body eq '';
    my @Line1=split(/\./,$Body); my $Ex=lc($Line1[$#Line1]);
    my @Line2=split(/ /,$Body);
    if   ($Ex eq 'exe')                    { return 1 } # sh
    elsif($Ex eq 'pl')                     { return 2 } # perl
    elsif($Ex eq 'rb')                     { return 8 } # ruby
    elsif($Ex eq 'py')                     { return 3 } # python
    elsif($Ex eq 'sh')                     { return 4 } # sh
    elsif(Left($Body,4) eq 'http' || Left($Body,5) eq 'file:') {
                                             return 5 } # http or file
+:
    elsif(IsIt($Body,'/') && $#Line2 == 0) { return 6 } # dir
    else                                   { return 7 } # sh command
}
sub MenuItem_Clicked {
    my $Kind=$Kind[$ARG[1]]; return(TRUE) if $Kind == 0;
    my $Body=$Body[$ARG[1]];
    if   ($Kind == 2) { system("/usr/bin/perl ".$Body) }
    elsif($Kind == 8) { system("/usr/bin/ruby ".$Body) }
    elsif($Kind == 3) { system("/usr/bin/python ".$Body) }
    elsif($Kind == 5) { system("/usr/bin/xdg-open ".$Body) }
    elsif($Kind == 6) { system("/usr/bin/nautilus ".$Body) }
    else              { system("/bin/sh -c '".$Body."'") } # 1, 4, 7
    FALSE;
}
sub Set_Image {
    my $ImageMenuItem=shift; my $Stock_ID=shift;
    my $Image=Gtk2::Image->new;
    $Image->set_from_icon_name($Stock_ID,'menu'); # Get icon only!
    $ImageMenuItem->set_image($Image);
    $ImageMenuItem->set_always_show_image(TRUE); # Required!
}
sub Set_Icon {
    my $Menu=shift; my $Inx=shift; my $Stock_ID=shift;
    my $ImageMenuItem=Gtk2::ImageMenuItem->new($Head[$Inx]);
    Set_Image($ImageMenuItem,$Stock_ID);
    $ImageMenuItem->signal_connect("activate"=> \&MenuItem_Clicked, $I
+nx );
    $Menu->append($ImageMenuItem);
}
sub Set_My_Icon {
    my $Title=shift; my $Stock_ID=shift;
    $ImageMenuItem=Gtk2::ImageMenuItem->new($Title);
    my $Image=Gtk2::Image->new_from_stock($Stock_ID,'menu'); # Get ico
+n and title
    $ImageMenuItem->set_image($Image);
    $ImageMenuItem->set_always_show_image(TRUE);
}
sub Make_Menu {
    @Head=(); @Body=(); @Kind=(); # Initialize
    my $Menu=Gtk2::Menu->new; $AppIndicator->set_menu($Menu);
    open(File, $Run_Any_File) || die "no file: ".$Run_Any_File;
    while(<File>) {
        chomp($ARG);
        next if Left($ARG,1) eq '#'; # comment
        next if $ARG eq '';
        my @Line=split(/\|/,$ARG);
        my $Head=Trim($Line[0]);
        my $Body=$#Line >= 1 ? Trim($Line[1]) : "";
        $Body =~ s/\{HOME\}/$HOME/;
        $Body =~ s/\{USER\}/$USER/;
        push(@Head,decode_utf8($Head)); push(@Body,$Body); push(@Kind,
+Get_Kind($Body));
    }
    close(File);
    if($#Head > -1) {
        for (0..$#Head) {
            if   ($Kind[$ARG] == 1) { Set_Icon($Menu,$ARG,'application
+-x-executable')  } # exe
            elsif($Kind[$ARG] == 8) { Set_Icon($Menu,$ARG,'application
+-x-ruby') }        # ruby
            elsif($Kind[$ARG] == 2) { Set_Icon($Menu,$ARG,'application
+-x-perl') }        # perl
            elsif($Kind[$ARG] == 3) { Set_Icon($Menu,$ARG,'text-x-pyth
+on') }             # python
            elsif($Kind[$ARG] == 4) { Set_Icon($Menu,$ARG,'application
+-x-executable')  } # sh
            elsif($Kind[$ARG] == 5) { Set_Icon($Menu,$ARG,'text-html')
+ }                 # http
            elsif($Kind[$ARG] == 6) { #nautilus
                if   ($Body[$ARG] eq $HOME)          { Set_Icon($Menu,
+$ARG,'gtk-home') }
                elsif($Body[$ARG] eq 'computer:///') { Set_Icon($Menu,
+$ARG,'computer') }
                elsif($Body[$ARG] eq 'network:///')  { Set_Icon($Menu,
+$ARG,'folder-remote') }
                elsif($Body[$ARG] eq 'trash:///')    { Set_Icon($Menu,
+$ARG,'user-trash') }
                else                                 { Set_Icon($Menu,
+$ARG,'gtk-directory') }
            }
            elsif($Kind[$ARG] == 7) { Set_Icon($Menu,$ARG,'application
+-x-executable')  } # sh command
            elsif($Head[$ARG] eq '--TEAROFF--') {
                $Menu->append(Gtk2::TearoffMenuItem->new); # ---------
            }
            elsif($Head[$ARG] eq '--SEPARATOR--') {
                $Menu->append(Gtk2::SeparatorMenuItem->new);
            }
            else { # comment
                my $MenuItem=Gtk2::MenuItem->new($Head[$ARG]); $Menu->
+append($MenuItem);
            }
        }
    }
    $Menu->append(Gtk2::SeparatorMenuItem->new); # ---------
    Set_My_Icon('Refresh','gtk-refresh');
    $ImageMenuItem->signal_connect("activate"=> \&Make_Menu);
    $Menu->append($ImageMenuItem);
    Set_My_Icon('About','gtk-about');
    $ImageMenuItem->signal_connect("activate"=> \&Make_About);
    $Menu->append($ImageMenuItem);
    Set_My_Icon('Quit','gtk-quit');
    $ImageMenuItem->signal_connect("activate",sub { Gtk2->main_quit; }
+);
    $Menu->append($ImageMenuItem);
    $Menu->show_all();
}
$AppIndicator=Gtk2::AppIndicator->new("Perl_AppIndicator",$Myself_Icon
+);
$AppIndicator->set_icon_theme_path(getcwd());
Make_Menu();
$AppIndicator->set_active();
Gtk2->main; TRUE;
__END__

[download]

The following file includes a japanese kanji. Sorry.

#
# 1st column # is a comment line.
# This file is UTF-8 coding for Linux.
# Spec by toskanosu.
# This file is made in ~/.run-any
# PATH end by ".pl"        ==> start by perl
# PATH end by ".py"        ==> start by python
# PATH end by ".sh"        ==> start by sh (without STDIN)
# PATH end by ".exe"       ==> start by sh (for wine)
# PATH start by "http"     ==> start by xdg-open (URI)
# no PATH                  ==> menu displayed (comment)
# --SEPARATOR--            ==> Gtk2 separator (-------)
# PATH without slash       ==> start by sh (without STDIN)
# PATH include space       ==> start by sh (without STDIN)
# else                     ==> start by xdg-open (folder)
#
# {HOME} is changed to ~
# {USER} is changed to your user name
#
# ---LABEL----            |   ---PATH------
--------------- important ---------------
&#9632; Paster                 |   {HOME}/perlsrc1/paster2sub.pl
Run GetTV (runner2)       |   {HOME}/perlsrc1/runner2.pl
GetRSS      &#12288;&#12288;          |   {HOME}/perlsrc1/getrssN1.pl
GetTV 1-day &#12288;&#12288;          |   perl {HOME}/perlsrc1/gettv.p
+l 0
Run-Show            &#12288;    |   {HOME}/perlsrc1/runner3x.pl
geany  ~/.run-any         |   geany {HOME}/.run-any
geany  ~/MenuItem.linux   |   geany {HOME}/MenuItem.linux
--------------- Folder ---------------
&#12467;&#12531;&#12500;&#12517;&#12540;&#12479;&#12540;&#12288;      
+     |   computer:///
perlsrc1                  |   {HOME}/perlsrc1
pysrc                     |   {HOME}/pysrc
Toshi-HP                  |   {HOME}/toshi_hp
Free Icon                 |   {HOME}/Hozon1/free-png
ubuntu tweak png          |   /usr/share/ubuntu-tweak/pixmaps
--SEPARATOR--
--------------- exec ---------------
K-&#23558;&#26827;                    |   wine /media/toshiaki/C-500GB
+/K-Shogi/K-Shogi.exe
Win&#29992;DLL&#31561;                |    winetricks
XPad                      |   xpad
nautilus restart          |   nautilus -q
world watch               |   gnome-clocks
--TEAROFF--
-------------- install--------------
Ubuntu Software Center    |   software-center
Synaptic Package Manager  |   synaptic-pkexec
--------------- setup ---------------
Set StartUp               |   gnome-session-properties
ubuntu-tweak              |   ubuntu-tweak
gnome-tweak-tool          |   gnome-tweak-tool
unity-tweak-tool          |   unity-tweak-tool
unsettings                |   unsettings
CompizConfig              |   ccsm
#EOF----------------------------------

[download]

Back to Cool Uses for Perl