/usr/lib/perl5/Gtk2/Unique.pm is in libgtk2-unique-perl 0.05-1build2.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 | package Gtk2::Unique;
=head1 NAME
Gtk2::Unique - Use single instance applications
=head1 SYNOPSIS
use Gtk2 '-init';
use Gtk2::Unique;
my $COMMAND_FOO = 1;
my $COMMAND_BAR = 2;
my $app = Gtk2::UniqueApp->new(
"org.example.UnitTets", undef,
foo => $COMMAND_FOO,
bar => $COMMAND_BAR,
);
if ($app->is_running) {
# The application is already running, send it a message
my ($text) = @ARGV ? @ARGV : ("Foo text here");
$app->send_message_by_name('foo', text => $text);
}
else {
# Create the single application instance and wait for other requests
my $window = create_application_window($app);
Gtk2->main();
}
sub create_application_window {
my ($app) = @_;
my $window = Gtk2::Window->new();
my $label = Gtk2::Label->new("Waiting for a message");
$window->add($label);
$window->set_size_request(480, 120);
$window->show_all();
$window->signal_connect(delete_event => sub {
Gtk2->main_quit();
return TRUE;
});
# Watch the main window and register a handler that will be called each time
# that there's a new message.
$app->watch_window($window);
$app->signal_connect('message-received' => sub {
my ($app, $command, $message, $time) = @_;
$label->set_text($message->get_text);
return 'ok';
});
}
=head1 DESCRIPTION
Gtk2::Unique is a Perl binding for the C library libunique which provides a
way for writing single instance application. If you launch a single instance
application twice, the second instance will either just quit or will send a
message to the running instance.
For more information about libunique see:
L<http://live.gnome.org/LibUnique>.
=head1 BUGS & API
This is the first release of the module, some bugs can be expected to be found.
Furthermore, the Perl API is not yet frozen, if you would like to suggest some
changes please do so as fast as possible.
=head1 AUTHORS
Emmanuel Rodriguez E<lt>potyl@cpan.orgE<gt>.
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2009-2010 by Emmanuel Rodriguez.
This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.8.8 or,
at your option, any later version of Perl 5 you may have available.
=cut
use warnings;
use strict;
use base 'DynaLoader';
use Gtk2;
our $VERSION = '0.05';
sub dl_load_flags { $^O eq 'darwin' ? 0x00 : 0x01 }
__PACKAGE__->bootstrap($VERSION);
1;
|