Gtk2-Unique-0.05/0000755000175000017500000000000011370330007013673 5ustar emmanuelemmanuelGtk2-Unique-0.05/MANIFEST.SKIP0000644000175000017500000000016711370311441015576 0ustar emmanuelemmanuel^build/ ^Makefile$ ^Makefile[.]old$ ^xs/.*[.][co]$ ^blib/ ^pm_to_blib$ ^[.]git ^Unique[.]bs$ ^Gtk2-Unique-.+\.tar\.gz$ Gtk2-Unique-0.05/lib/0000755000175000017500000000000011370330007014441 5ustar emmanuelemmanuelGtk2-Unique-0.05/lib/Gtk2/0000755000175000017500000000000011370330007015250 5ustar emmanuelemmanuelGtk2-Unique-0.05/lib/Gtk2/Unique.pm0000644000175000017500000000453511370327373017077 0ustar emmanuelemmanuelpackage 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. =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 Epotyl@cpan.orgE. =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; Gtk2-Unique-0.05/Changes0000644000175000017500000000122411370327674015205 0ustar emmanuelemmanuelRevision history for Gtk2::Unique 0.05 Wed May 5 19:48:14 CEST 2010 Minor XS update: the length of a string was computed twice. 0.04 Tue Nov 3 22:27:54 CEST 2009 The signal Gtk2::UniqueApp::message-received now receives the command name instaed of the command id. The macro UNIQUE_CHECK_VERSION will be fixed in 1.1.0. 0.03 Tue Oct 20 20:21:27 CEST 2009 Add the version check macros to the bindings. Fix the unit tests (now using the bacon backend). Documentation updates. 0.02 Sun Jul 12 16:28:57 CEST 2009 More perlish API with send_message_by_name(). 0.01 Thu Apr 2 15:44:36 CEST 2009 First version, released on an unsuspecting world. Gtk2-Unique-0.05/META.yml0000644000175000017500000000116111370330007015143 0ustar emmanuelemmanuel--- #YAML:1.0 name: Gtk2-Unique version: 0.05 abstract: Use single instance applications author: - Emmanuel Rodriguez license: perl, lgpl distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: Gtk2: 1.161 no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.55_02 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 repository: http://github.com/potyl/gtk2-unique/tree/master Gtk2-Unique-0.05/README0000644000175000017500000000233511370327330014563 0ustar emmanuelemmanuelGtk2::Unique ========= Perl bindings for the C library "libunique" that provides a mechanism for writing single instance applications. If you launch a single instance application twice, the second instance will either just quit or will send a message to the running instance. Unique makes it easy to write this kind of applications, by providing a base class, taking care of all the IPC machinery needed to send messages to a running instance, and also handling the startup notification side. For more information about libunique refer to the library's web site: http://live.gnome.org/LibUnique INSTALLATION To install this module, run the following commands: perl Makefile.PL make make test make install SUPPORT AND DOCUMENTATION After installing, you can find documentation for this module with the perldoc command. perldoc Gtk2::Unique Also feel free to take a look at the examples in the folder "examples/" and to play around with them. For any kind of help or support simply report a bug or join us in the IRC channel #gtk2-perl on freenode. COPYRIGHT AND LICENCE Copyright (C) 2009-2010 Emmanuel Rodriguez This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Gtk2-Unique-0.05/maps0000644000175000017500000000061411370311441014560 0ustar emmanuelemmanuelUNIQUE_TYPE_APP UniqueApp GObject Gtk2::UniqueApp UNIQUE_TYPE_BACKEND UniqueBackend GObject Gtk2::UniqueBackend UNIQUE_TYPE_COMMAND UniqueCommand GEnum Gtk2::UniqueCommand UNIQUE_TYPE_RESPONSE UniqueResponse GEnum Gtk2::UniqueResponse UNIQUE_TYPE_MESSAGE_DATA UniqueMessageData GBoxed Gtk2::UniqueMessageData Gtk2-Unique-0.05/Makefile.PL0000644000175000017500000000456111370327336015666 0ustar emmanuelemmanueluse strict; use warnings; use ExtUtils::MakeMaker; use Cwd; use File::Spec; use Gtk2::CodeGen; use Glib::MakeHelper; use ExtUtils::Depends; use ExtUtils::PkgConfig; my $DEPENDS; my @XS_FILES = (); exit main(); sub main { # Create the build folder used by the code generation utilities mkdir 'build', 0777; # Find libunique my @typemaps = (); my @deps = ('Glib'); my %pkgconfig; eval { %pkgconfig = ExtUtils::PkgConfig->find("unique-1.0"); push @XS_FILES, ; push @typemaps, 'maps'; push @deps, 'Gtk2'; }; if (my $error = $@) { warn "FAIL: ", $error; return; } $DEPENDS = ExtUtils::Depends->new('Gtk2::Unique', @deps); $DEPENDS->add_pm( File::Spec->catfile('lib', 'Gtk2', 'Unique.pm'), File::Spec->catfile('$(INST_LIBDIR)', 'Unique.pm'), ); # Code generation Gtk2::CodeGen->parse_maps('unique', input => [ @typemaps ]); Gtk2::CodeGen->write_boot( ignore => qr/^Gtk2::Unique$/, xs_files => [ @XS_FILES ], ); $DEPENDS->set_inc($pkgconfig{cflags} . ' -I./build'); $DEPENDS->set_libs($pkgconfig{libs}); $DEPENDS->add_xs(@XS_FILES); $DEPENDS->add_typemaps( File::Spec->catfile(cwd(), 'build', 'unique.typemap'), ); $DEPENDS->install( File::Spec->catfile('build', 'unique-autogen.h'), 'unique-perl.h', ); $DEPENDS->save_config(File::Spec->catfile('build', 'IFiles.pm')); # Create the Makefile WriteMakefile( AUTHOR => 'Emmanuel Rodriguez ', NAME => 'Gtk2::Unique', VERSION_FROM => File::Spec->catfile('lib', 'Gtk2', 'Unique.pm'), ABSTRACT_FROM => File::Spec->catfile('lib', 'Gtk2', 'Unique.pm'), LICENSE => 'perl, lgpl', PREREQ_PM => { 'Gtk2' => '1.161', # Other verions might work too (Ubuntu 8.04 has this version) }, PREREQ_FATAL => 1, XSPROTOARG => '-noprototypes ', MAN3PODS => { Glib::MakeHelper->do_pod_files(@XS_FILES), }, META_MERGE => { repository => 'http://github.com/potyl/gtk2-unique/tree/master', }, $DEPENDS->get_makefile_vars(), # Remove the build folder when doing "make clean" clean => { FILES => 'build', }, ); return 0; } sub MY::postamble { my $postamble = Glib::MakeHelper->postamble_clean(); $postamble .= Glib::MakeHelper->postamble_docs_full( DEPENDS => $DEPENDS, XS_FILES => [ @XS_FILES ], COPYRIGHT => 'Copyright (C) 2009-2010 by Emmanuel Rodriguez' ); return $postamble; } Gtk2-Unique-0.05/t/0000755000175000017500000000000011370330007014136 5ustar emmanuelemmanuelGtk2-Unique-0.05/t/Unique.t0000644000175000017500000000177411370311441015603 0ustar emmanuelemmanuel#!/usr/bin/perl use strict; use warnings; use Gtk2::TestHelper tests => 12; use Gtk2::Unique; exit tests(); sub tests { test_version(); return 0; } sub test_version { ok($Gtk2::Unique::VERSION, "Module loaded"); ok(Gtk2::Unique::VERSION, "Version"); ok(Gtk2::Unique::VERSION_HEX, "Version hex"); ok(Gtk2::Unique::API_VERSION, "API version"); ok(Gtk2::Unique::PROTOCOL_VERSION, "Protocol version"); ok(Gtk2::Unique::DEFAULT_BACKEND, "Default backend"); ok(defined Gtk2::Unique::MAJOR_VERSION, "MAJOR_VERSION exists"); ok(defined Gtk2::Unique::MINOR_VERSION, "MINOR_VERSION exists"); ok(defined Gtk2::Unique::MICRO_VERSION, "MICRO_VERSION exists"); ok (Gtk2::Unique->CHECK_VERSION(0,0,0), "CHECK_VERSION pass"); ok (!Gtk2::Unique->CHECK_VERSION(50,0,0), "CHECK_VERSION fail"); my @version = Gtk2::Unique->GET_VERSION_INFO; my @expected = ( Gtk2::Unique::MAJOR_VERSION, Gtk2::Unique::MINOR_VERSION, Gtk2::Unique::MICRO_VERSION, ); is_deeply(\@version, \@expected, "GET_VERSION_INFO"); } Gtk2-Unique-0.05/t/UniqueBackend.t0000644000175000017500000000164111370311441017044 0ustar emmanuelemmanuel#!/usr/bin/perl use strict; use warnings; use Gtk2::TestHelper tests => 8; use Gtk2::Unique; exit tests(); sub tests { my $backend = Gtk2::UniqueBackend->create(); isa_ok($backend, 'Gtk2::UniqueBackend'); is($backend->get_name, undef, "get_name()"); $backend->set_name("perl-testing"); is($backend->get_name, "perl-testing", "set_name()"); is($backend->get_startup_id, undef, "get_startup_id()"); $backend->set_startup_id("staring"); is($backend->get_startup_id, "staring", "set_startup_id()"); isa_ok($backend->get_screen, 'Gtk2::Gdk::Screen', "get_screen()"); $backend->set_screen(Gtk2::Gdk::Screen->get_default); is($backend->get_screen, Gtk2::Gdk::Screen->get_default, "set_screen()"); ok($backend->get_workspace >= 0, "get_workspace()"); # ok($backend->request_name(), "request_name()"); # my $response = $backend->send_message(1, undef, 0); # is ($response, '', "send_message()"); return 0; } Gtk2-Unique-0.05/t/UniqueApp.t0000644000175000017500000000600411370311441016233 0ustar emmanuelemmanuel#!/usr/bin/perl use strict; use warnings; use Gtk2::TestHelper tests => 20; use Gtk2::Unique; my $COMMAND_FOO = 1; my $COMMAND_BAR = 2; my $APP_NAME = 'org.example.UnitTets'; # The D-Bus backend doesn't seem to realize that an application is no longer # running when created from the same Perl script. The second call to # Gtk2::UniqueApp->new() will think that the application is already running when # it isn't. This happens even if the original $app variable exists no longer. # # Besides the bacon backend is the only one guaranteed to exist. # local $ENV{UNIQUE_BACKEND} = 'bacon'; exit tests(); sub tests { tests_new(); tests_new_with_commands(); return 0; } sub tests_new { my $app = Gtk2::UniqueApp->new($APP_NAME, undef); isa_ok($app, 'Gtk2::UniqueApp'); $app->add_command(foo => $COMMAND_FOO); $app->add_command(bar => $COMMAND_BAR); generic_test($app); } sub tests_new_with_commands { my @commands = ( foo => $COMMAND_FOO, bar => $COMMAND_BAR, ); my $app = Gtk2::UniqueApp->new_with_commands($APP_NAME, undef, @commands); isa_ok($app, 'Gtk2::UniqueApp'); generic_test($app); my $pass; # Check that the constructor enforces ints for the command ID $app = undef; $pass = 1; eval { $app = Gtk2::UniqueApp->new_with_commands($APP_NAME, undef, foo => 'not-an-int'); $pass = 0; }; if (my $error = $@) { $pass = 1; } ok($pass, "new_with_command() checks for IDs as int"); # Check that the constructor enforces the argument count $app = undef; $pass = 1; eval { $app = Gtk2::UniqueApp->new_with_commands($APP_NAME, undef, foo => 1, 'bar'); $pass = 0; }; if (my $error = $@) { $pass = 1; } ok($pass, "new_with_command() checks for argument count"); } sub generic_test { my ($app) = @_; if (! $app->is_running()) { SKIP: { skip "No app is running; execute perl -Mblib t/unit-tests.pl", 8; } return; } my $response; $response = $app->send_message($COMMAND_FOO, data => "data in here"); is($response, 'ok', "send_message(data)"); $response = $app->send_message_by_name(foo => data => "data in here"); is($response, 'ok', "send_message_by_name(data)"); $response = $app->send_message($COMMAND_FOO, text => "hello"); is($response, 'ok', "send_message(text)"); $response = $app->send_message_by_name(foo => text => "hello"); is($response, 'ok', "send_message_by_name(text)"); $response = $app->send_message($COMMAND_BAR, filename => __FILE__); is($response, 'invalid', "send_message(filename)"); $response = $app->send_message_by_name(bar => filename => __FILE__); is($response, 'invalid', "send_message_by_name(filename)"); $response = $app->send_message($COMMAND_FOO, uris => [ 'http://live.gnome.org/LibUnique', 'http://gtk2-perl.sourceforge.net/', ]); is($response, 'ok', "send_message(uris)"); $response = $app->send_message_by_name(foo =>, uris => [ 'http://live.gnome.org/LibUnique', 'http://gtk2-perl.sourceforge.net/', ]); is($response, 'ok', "send_message_by_name(uris)"); my $window = Gtk2::Window->new(); $app->watch_window($window); } Gtk2-Unique-0.05/t/unit-tests.pl0000644000175000017500000000325411370311441016617 0ustar emmanuelemmanuel#!/usr/bin/perl use strict; use warnings; use Glib qw(TRUE FALSE); use Gtk2 '-init'; use Gtk2::Unique; use Data::Dumper; my $COMMAND_FOO = 1; my $COMMAND_BAR = 2; # Use the bacon backend as it is the only that really works with unit tests. # See t/UniqueApp.t for more details. local $ENV{UNIQUE_BACKEND} = 'bacon'; exit main(); sub main { my $app = Gtk2::UniqueApp->new( "org.example.UnitTets", undef, foo => $COMMAND_FOO, bar => $COMMAND_BAR, ); if ($app->is_running) { die "Application is already running"; } # Create the single application instance and wait for other requests my $window = create_application($app); Gtk2->main(); return 0; } # # Called when the application needs to be created. This happens when there's no # other instance running. # sub create_application { my ($app) = @_; # Standard window and windgets my $window = Gtk2::Window->new(); $window->set_title("Gtk2::Unique - Unit Tests"); $window->set_size_request(480, 240); my $textview = Gtk2::TextView->new(); my $scroll = Gtk2::ScrolledWindow->new(); my $buffer = $textview->get_buffer; # Widget packing $scroll->add($textview); $window->add($scroll); $window->show_all(); # Widget signals $window->signal_connect(delete_event => sub { Gtk2->main_quit(); return TRUE; }); # Listen for new commands $app->watch_window($window); $app->signal_connect('message-received' => sub { my ($app, $command, $message, $time) = @_; my $text = Dumper($message->get); $buffer->insert($buffer->get_end_iter, "$command: $text\n"); # The command FOO will succeed while the command BAR will fail return $command == $COMMAND_FOO ? 'ok' : 'invalid'; }); return $window; } Gtk2-Unique-0.05/xs/0000755000175000017500000000000011370330007014325 5ustar emmanuelemmanuelGtk2-Unique-0.05/xs/UniqueApp.xs0000644000175000017500000002561211370324511016621 0ustar emmanuelemmanuel#include "unique-perl.h" #include static void perl_unique_app_marshall_message_received ( GClosure *closure, GValue *return_value, guint n_param_values, const GValue *param_values, gpointer invocant_hint, gpointer marshal_data) { UniqueApp *app; gint command; const gchar *command_name; dGPERL_CLOSURE_MARSHAL_ARGS; PERL_UNUSED_VAR (return_value); PERL_UNUSED_VAR (n_param_values); PERL_UNUSED_VAR (invocant_hint); GPERL_CLOSURE_MARSHAL_INIT (closure, marshal_data); ENTER; SAVETMPS; PUSHMARK (SP); GPERL_CLOSURE_MARSHAL_PUSH_INSTANCE (param_values); app = (UniqueApp *) g_value_get_object (param_values + 0); command = g_value_get_int (param_values + 1); command_name = (const gchar *) unique_command_to_string (app, command); XPUSHs (sv_2mortal (newSVpv (command_name, 0))); XPUSHs (sv_2mortal (gperl_sv_from_value (param_values + 2))); XPUSHs (sv_2mortal (gperl_sv_from_value (param_values + 3))); GPERL_CLOSURE_MARSHAL_PUSH_DATA; PUTBACK; GPERL_CLOSURE_MARSHAL_CALL (G_SCALAR); SPAGAIN; if (count != 1) { croak ("message-received handlers need to return a single value"); } g_value_set_enum (return_value, SvUniqueResponse (POPs)); FREETMPS; LEAVE; } MODULE = Gtk2::UniqueApp PACKAGE = Gtk2::UniqueApp PREFIX = unique_app_ BOOT: gperl_signal_set_marshaller_for ( UNIQUE_TYPE_APP, "message-received", perl_unique_app_marshall_message_received ); =for object Gtk2::UniqueApp - Base class for singleton applications =cut =for position SYNOPSIS =head1 SYNOPSIS 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 $app->send_message_by_name('foo', text => "Hello world"); } else { 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'; }); Gtk2->main(); } =for position DESCRIPTION =head1 DESCRIPTION B is the base class for single instance applications. You can either create an instance of UniqueApp via Cnew()> and C_with_commands()>; or you can subclass Gtk2::UniqueApp with your own application class. A Gtk2::UniqueApp instance is guaranteed to either be the first running at the time of creation or be able to send messages to the currently running instance; there is no race possible between the creation of the Gtk2::UniqueApp instance and the call to C. The usual method for using the Gtk2::UniqueApp API is to create a new instance, passing an application-dependent name as construction-only property; the C property is required, and should be in the form of a domain name, like I. After the creation, you should check whether an instance of your application is already running, using C; if this method returns C the usual application construction sequence can continue; if it returns C you can either exit or send a message using L and C. You can define custom commands using C: you need to provide an arbitrary integer and a string for the command. =cut =for apidoc new_with_commands An alias for Cnew()>. =cut =for apidoc Creates a new Gtk2::UniqueApp instance for name passing a start-up notification id startup_id. The name must be a unique identifier for the application, and it must be in form of a domain name, like I. If startup_id is C the DESKTOP_STARTUP_ID environment variable will be check, and if that fails a "fake" startup notification id will be created. Once you have created a Gtk2::UniqueApp instance, you should check if any other instance is running, using C. If another instance is running you can send a command to it, using the C function; after that, the second instance should quit. If no other instance is running, the usual logic for creating the application can follow. =cut UniqueApp_noinc* unique_app_new (class, const gchar *name, const gchar_ornull *startup_id, ...) ALIAS: new_with_commands = 1 PREINIT: UniqueApp *app = NULL; CODE: PERL_UNUSED_VAR(ix); if (items == 3) { app = unique_app_new(name, startup_id); } else if (items > 3 && (items % 2 == 1)) { /* Calling unique_app_new_with_command(), First create a new app with unique_app_new() and then populate the commands one by one with unique_app_add_command(). */ int i; app = unique_app_new(name, startup_id); for (i = 3; i < items; i += 2) { SV *command_name_sv = ST(i); SV *command_id_sv = ST(i + 1); gchar *command_name = NULL; gint command_id; if (! looks_like_number(command_id_sv)) { g_object_unref(G_OBJECT(app)); croak( "Invalid command_id at position %d, expected a number but got '%s'", i, SvGChar(command_id_sv) ); } command_name = SvGChar(command_name_sv); command_id = SvIV(command_id_sv); unique_app_add_command(app, command_name, command_id); } } else { croak( "Usage: Gtk2::UniqueApp->new(name, startup_id)" "or Gtk2::UniqueApp->new_with_commands(name, startup_id, @commands)" ); } RETVAL = app; OUTPUT: RETVAL =for apidoc Adds command_name as a custom command that can be used by app. You must call C before C in order to use the newly added command. The command name is used internally: you need to use the command's logical id in C and inside the I signal. =cut void unique_app_add_command (UniqueApp *app, const gchar *command_name, gint command_id) =for apidoc Makes app "watch" a window. Every watched window will receive startup notification changes automatically. =cut void unique_app_watch_window (UniqueApp *app, GtkWindow *window) =for apidoc Checks whether another instance of app is running. =cut gboolean unique_app_is_running (UniqueApp *app) # # $app->send_message($ID) -> unique_app_send_message(app, command_id, NULL); # $app->send_message($ID, text => $text) -> set_text() unique_app_send_message(app, command_id, message); # $app->send_message($ID, data => $data) -> set() unique_app_send_message(app, command_id, message); # $app->send_message($ID, uris => @uri) -> set_uris() unique_app_send_message(app, command_id, message); # # $app->send_message_by_name('command') -> unique_app_send_message(app, command_id, NULL); # $app->send_message_by_name('command', text => $text) -> set_text() unique_app_send_message(app, command_id, message); # $app->send_message_by_name('command', data => $data) -> set() unique_app_send_message(app, command_id, message); # $app->send_message_by_name('command', uris => @uri) -> set_uris() unique_app_send_message(app, command_id, message); # # =for apidoc send_message Same as C, but uses a message id instead of a name. =cut =for apidoc Sends command to a running instance of app. If you need to pass data to the instance, you have to indicate the type of message that will be passed. The accepted types are: =over =item text A plain text message =item data Rad data =item filename A file name =item uris URI, multiple values can be passed =back The running application will receive a I signal and will call the various signal handlers attach to it. If any handler returns a C different than C, the emission will stop. Usages: $app->send_message_by_name(write => data => $data); $app->send_message_by_name(greet => text => "Hello World!"); $app->send_message_by_name(open => uris => 'http://search.cpan.org/', 'http://www.gnome.org/', ); B: If you prefer to use an ID instead of a message name then use the function C. The usage is the same as this one. =cut UniqueResponse unique_app_send_message_by_name (UniqueApp *app, SV *command, ...) ALIAS: send_message = 1 PREINIT: UniqueMessageData *message = NULL; SV **s = NULL; gint command_id = 0; CODE: switch (ix) { case 0: { gchar *command_name = SvGChar(command); command_id = unique_command_from_string(app, command_name); if (command_id == 0) { croak("Command '%s' isn't registered with the application", command_name); } } break; case 1: { command_id = (gint) SvIV(command); } break; default: croak("Method called with the wrong name"); } if (items == 4) { SV *sv_data; gchar *type; message = unique_message_data_new(); type = SvGChar(ST(2)); sv_data = ST(3); if (g_strcmp0(type, "data") == 0) { SV *sv; STRLEN length; char *data; data = SvPV(sv_data, length); unique_message_data_set(message, data, length); } else if (g_strcmp0(type, "text") == 0) { STRLEN length; char *text; length = sv_len(sv_data); text = SvGChar(sv_data); unique_message_data_set_text(message, text, length); } else if (g_strcmp0(type, "filename") == 0) { SV *sv; char *filename; filename = SvGChar(sv_data); unique_message_data_set_filename(message, filename); } else if (g_strcmp0(type, "uris") == 0) { gchar **uris = NULL; gsize length; AV *av = NULL; int i; if (SvTYPE(SvRV(sv_data)) != SVt_PVAV) { unique_message_data_free(message); croak("Value for the type 'uris' must be an array ref"); } /* Convert the Perl array into a C array of strings */ av = (AV*) SvRV(sv_data); length = av_len(av) + 2; /* last index + extra NULL padding */ uris = g_new0(gchar *, length); for (i = 0; i < length - 1; ++i) { SV **uri_sv = av_fetch(av, i, FALSE); uris[i] = SvGChar(*uri_sv); } uris[length - 1] = NULL; unique_message_data_set_uris(message, uris); g_free(uris); } else { unique_message_data_free(message); croak("Parameter 'type' must be: 'data', 'text', 'filename' or 'uris'; got %s", type); } } else if (items == 2) { message = NULL; } else { croak( "Usage: $app->send_message($id, $type => $data)" " or $app->send_message($id, uris => [])" " or $app->send_message($id)" ); } RETVAL = unique_app_send_message(app, command_id, message); if (message) { unique_message_data_free(message); } OUTPUT: RETVAL Gtk2-Unique-0.05/xs/Unique.xs0000644000175000017500000000354511370311441016157 0ustar emmanuelemmanuel#include "unique-perl.h" #define _FIXED_UNIQUE_CHECK_VERSION(major,minor,micro) \ ((UNIQUE_MAJOR_VERSION > (major)) || \ (UNIQUE_MAJOR_VERSION == (major) && UNIQUE_MINOR_VERSION > (minor)) || \ (UNIQUE_MAJOR_VERSION == (major) && UNIQUE_MINOR_VERSION == (minor) && UNIQUE_MICRO_VERSION > (micro))) MODULE = Gtk2::Unique PACKAGE = Gtk2::Unique PREFIX = unique_ PROTOTYPES: DISABLE BOOT: #include "register.xsh" #include "boot.xsh" guint MAJOR_VERSION () CODE: RETVAL = UNIQUE_MAJOR_VERSION; OUTPUT: RETVAL guint MINOR_VERSION () CODE: RETVAL = UNIQUE_MINOR_VERSION; OUTPUT: RETVAL guint MICRO_VERSION () CODE: RETVAL = UNIQUE_MICRO_VERSION; OUTPUT: RETVAL void GET_VERSION_INFO (class) PPCODE: EXTEND (SP, 3); PUSHs (sv_2mortal (newSViv (UNIQUE_MAJOR_VERSION))); PUSHs (sv_2mortal (newSViv (UNIQUE_MINOR_VERSION))); PUSHs (sv_2mortal (newSViv (UNIQUE_MICRO_VERSION))); PERL_UNUSED_VAR (ax); gboolean CHECK_VERSION (class, guint major, guint minor, guint micro) CODE: /* * So check version is broken as it has a typo and won't compile. But we need * check version to see if libunique has fixed this! * * For now we define our own check version and use that one instead. */ #if ! _FIXED_UNIQUE_CHECK_VERSION(1, 1, 0) RETVAL = _FIXED_UNIQUE_CHECK_VERSION(major, minor, micro); #else RETVAL = UNIQUE_CHECK_VERSION(major, minor, micro); #endif OUTPUT: RETVAL const gchar* VERSION () CODE: RETVAL = UNIQUE_VERSION_S; OUTPUT: RETVAL guint VERSION_HEX () CODE: RETVAL = UNIQUE_VERSION_HEX; OUTPUT: RETVAL const gchar* API_VERSION () CODE: RETVAL = UNIQUE_API_VERSION_S; OUTPUT: RETVAL const gchar* PROTOCOL_VERSION () CODE: RETVAL = UNIQUE_PROTOCOL_VERSION_S; OUTPUT: RETVAL const gchar* DEFAULT_BACKEND () CODE: RETVAL = UNIQUE_DEFAULT_BACKEND_S; OUTPUT: RETVAL Gtk2-Unique-0.05/xs/UniqueMessageData.xs0000644000175000017500000000553611370311441020260 0ustar emmanuelemmanuel#include "unique-perl.h" MODULE = Gtk2::UniqueMessageData PACKAGE = Gtk2::UniqueMessageData PREFIX = unique_message_data_ =for object Gtk2::UniqueMessageData - Message container for Gtk2::UniqueApp =cut =for position DESCRIPTION =head1 DESCRIPTION This class wraps the messages passed to a C. Usually you will never create a message with the Perl API has this is done by the bindings on your behalf. Since messages are only read through the Perl bidings the methods for setting the contents of a message are not accessible. What's important to understand is that a C is a generic container for all message types (text, data, filename and uris). There's no way to query what kind of message a C holds. It is the responsability of each application to know it in advance and to call the proper get methods. If you don't call the proper get method you could have a segmentation fault in your application as the C library will try to unmarshall the message with the wrong code. You can retrieve the data set using C, C or C. =cut =for apidoc Retrieves the raw data of the message. =cut SV* unique_message_data_get (UniqueMessageData *message_data) PREINIT: const guchar *string = NULL; gint length = 0; CODE: string = unique_message_data_get(message_data, &length); if (string == NULL) {XSRETURN_UNDEF;} RETVAL = newSVpvn(string, length); OUTPUT: RETVAL =for apidoc Retrieves the text. =cut gchar* unique_message_data_get_text (UniqueMessageData *message_data) =for apidoc Retrieves the filename. =cut gchar* unique_message_data_get_filename (UniqueMessageData *message_data) =for apidoc Retrieves the URIs as an array. =cut void unique_message_data_get_uris (UniqueMessageData *message_data) PREINIT: gchar **uris = NULL; gchar *uri = NULL; gint i = 0; PPCODE: uris = unique_message_data_get_uris(message_data); if (uris == NULL) {XSRETURN_EMPTY;} for (i = 0; TRUE; ++i) { uri = uris[i]; if (uri == NULL) {break;} XPUSHs(sv_2mortal(newSVGChar(uri))); } g_strfreev(uris); =for apidoc Returns a pointer to the screen from where the message came. You can use C to move windows or dialogs to the right screen. This field is always set by the Unique library. =cut GdkScreen* unique_message_data_get_screen (UniqueMessageData *message_data) =for apidoc Retrieves the startup notification id set inside message_data. This field is always set by the Unique library. =cut const gchar* unique_message_data_get_startup_id (UniqueMessageData *message_data) =for apidoc Retrieves the workspace number from where the message came. This field is always set by the Unique library. =cut guint unique_message_data_get_workspace (UniqueMessageData *message_data) Gtk2-Unique-0.05/xs/UniqueBackend.xs0000644000175000017500000000323111370311441017417 0ustar emmanuelemmanuel#include "unique-perl.h" MODULE = Gtk2::UniqueBackend PACKAGE = Gtk2::UniqueBackend PREFIX = unique_backend_ =for object Gtk2::UniqueBackend - Backend abstraction =cut =for position DESCRIPTION =head1 DESCRIPTION Gkt2::UniqueBackend is the base, abstract class implemented by the different IPC mechanisms used by Gtk2::Unique. Each Gtk2::UniqueApp instance creates a Gkt2::UniqueBackend to request the name or to send messages. =cut =for apidoc Creates a Gkt2::UniqueBackend using the default backend defined at compile time. You can override the default backend by setting the UNIQUE_BACKEND environment variable with the name of the desired backend. =cut UniqueBackend_noinc* unique_backend_create (class) C_ARGS: /* No args */ const gchar* unique_backend_get_name (UniqueBackend *backend) void unique_backend_set_name (UniqueBackend *backend, const gchar *name) const gchar* unique_backend_get_startup_id (UniqueBackend *backend) void unique_backend_set_startup_id (UniqueBackend *backend, const gchar *startup_id) GdkScreen* unique_backend_get_screen (UniqueBackend *backend) void unique_backend_set_screen (UniqueBackend *backend, GdkScreen *screen) =for apidoc Retrieves the current workspace. =cut guint unique_backend_get_workspace (UniqueBackend *backend) =for apidoc Requests the name set using C and this backend. =cut gboolean unique_backend_request_name (UniqueBackend *backend) =for apidoc Sends command_id, and optionally message_data, to a running instance using backend. =cut UniqueResponse unique_backend_send_message (UniqueBackend *backend, gint command_id, UniqueMessageData_ornull *message_data, guint time_) Gtk2-Unique-0.05/examples/0000755000175000017500000000000011370330007015511 5ustar emmanuelemmanuelGtk2-Unique-0.05/examples/sample.pl0000644000175000017500000000403111370311441017326 0ustar emmanuelemmanuel#!/usr/bin/perl use strict; use warnings; use Glib qw(TRUE FALSE); use Gtk2 '-init'; use Gtk2::Unique; use Encode; use Data::Dumper; my $COMMAND_WRITE = 1; exit main(); sub main { die "Usage: message\n" unless @ARGV; my ($text) = @ARGV; # If we want to pass UTF-8 text in the command line arguments $text = decode('UTF-8', $text); # As soon as we create the UniqueApp instance we either have the name we # requested ("org.mydomain.MyApplication", in the example) or we don't because # there already is an application using the same name. my $app = Gtk2::UniqueApp->new( "org.example.Sample", undef, write => $COMMAND_WRITE, ); # If there already is an instance running, this will return TRUE; there's no # race condition because the check is already performed at construction time. if ($app->is_running) { my $response = $app->send_message_by_name(write => data => $text); return 0; } # Create the single application instance and wait for other requests my $window = create_application($app, $text); Gtk2->main(); return 0; } # # Called when the application needs to be created. This happens when there's no # other instance running. # sub create_application { my ($app, $text) = @_; # Standard window and windgets my $window = Gtk2::Window->new(); $window->set_title("Unique - Example"); $window->set_size_request(480, 240); my $textview = Gtk2::TextView->new(); my $scroll = Gtk2::ScrolledWindow->new(); my $buffer = $textview->get_buffer; $buffer->insert($buffer->get_end_iter, "$text\n"); # Widget packing $scroll->add($textview); $window->add($scroll); $window->show_all(); # Widget signals $window->signal_connect(delete_event => sub { Gtk2->main_quit(); return TRUE; }); # Listen for new commands $app->watch_window($window); $app->signal_connect('message-received' => sub { my ($app, $command, $message, $time) = @_; my $text = Dumper($message->get); $buffer->insert($buffer->get_end_iter, "$text\n"); # Must return a "Gtk2::UniqueResponse" return 'ok'; }); return $window; } Gtk2-Unique-0.05/unique-perl.h0000644000175000017500000000020611370311441016311 0ustar emmanuelemmanuel#ifndef _UNIQUE_PERL_H_ #include #include #include "unique-autogen.h" #endif /* _UNIQUE_PERL_H_ */ Gtk2-Unique-0.05/MANIFEST0000644000175000017500000000047611370330007015033 0ustar emmanuelemmanuelChanges MANIFEST MANIFEST.SKIP Makefile.PL README lib/Gtk2/Unique.pm maps unique-perl.h xs/UniqueApp.xs xs/UniqueBackend.xs xs/UniqueMessageData.xs xs/Unique.xs t/Unique.t t/UniqueApp.t t/UniqueBackend.t t/unit-tests.pl examples/sample.pl META.yml Module meta-data (added by MakeMaker)