Perl и GUI. Взаимодействие приложений

Иногда возникает необходимость сделать обмен данными между приложениями (например выполнить какую-либо команду в Internet Explorer, Excel).
Платформа Microsoft Windows предоставляет нам несколько механизмов, это и OLE, COM и… DDE.

DDE был введен в 1987 году, позже была сетевая реализация NetDDE, и используется до сих пор.
Работать с DDE очень просто, не требуется подключать с CPAN дополнительные модули, все есть в tkkit.

Рассмотрим на примере двух приложений приёмника и отправителя.



Описание и код под хабракатом.


Для работы необходимо подключить пакет dde

В Tcl это выглядело бы так:

package require dde

Прежде чем программы начнут обмениваться информацией, необходимо задать имя «нашего сервера».
Пусть это будет «PerlDDE»

Программа-приёмник может обратывать две команды:
message — вывести сообщение


и oops — вызывается когда пользователь закрывает программу-клиент.
Перед нами будет такая грустная картина:

Код программы-приёмника:

#!/usr/bin/perl
use strict;
use feature ':5.10';
use Tkx;

# Подключаем модуль для работы с DDE
Tkx::package_require('dde');

# Устанавливаем обработчик
Tkx::dde_servername(-handler => \&dde_handle, 'PerlDDE');

# Создаем окно
my %UI = ();
my $mw = Tkx::widget->new('.');

$mw->g_wm_title('Perl/Tkx DDE');
$mw->g_wm_minsize(qw(300  200));

my $label = $mw->new_ttk__label(-text         => 'Receiver:');
my $entry = $mw->new_ttk__entry(-textvariable => \$UI{entry},
                                -state        => 'readonly');

Tkx::grid($label, -row => 0, -column => 0, -sticky => 'ew', -padx => 4, -pady => 4);
Tkx::grid($entry, -row => 1, -column => 0, -sticky => 'ew', -padx => 4, -pady => 4);

Tkx::grid(columnconfigure => $mw, 0, -weight => 1);

Tkx::MainLoop();
1;

sub dde_handle {
    
    PROCESS_DDE_ARGS:
    foreach my $ddeval (@_) {
        next PROCESS_DDE_ARGS if ref($ddeval);
        
        $UI{entry}        = $ddeval;
        my ($key, $value) = Tkx::SplitList($ddeval);
        
        given ($key) {             
            when ('message') {
                Tkx::tk___messageBox(
                    -title   => 'DDE Receiver',
                    -message => "Received message:\n$value",
                ) if length $value;
            }
            
            when ('oops') {
                $UI{entry} = 'Oops, sender was terminated';
            }
            
            # ...
        }
    }
}

Код программы-отправителя:

#!/usr/bin/perl
use strict;
use Tkx;

Tkx::package_require('dde');

my %UI;
my $mw    = Tkx::widget->new('.');
$mw->g_wm_title('Perl/Tkx DDE');
$mw->g_wm_minsize(qw(300  200));

my $label = $mw->new_ttk__label(-text         => 'Sender:');
my $copy  = $mw->new_ttk__label(-text         => 'santeri.habrahabr.ru');
my $msg_e = $mw->new_ttk__entry(-textvariable => \$UI{msg});
my $msg_b = $mw->new_ttk__button(
    -text    => 'Message :)',
    -command => sub {
        send_message(message => $UI{msg});
    },
);

Tkx::bind($msg_e => '<Return>', sub {
    $msg_b->invoke();
});

# oops, если закрыли программу
$mw->g_wm_protocol(WM_DELETE_WINDOW => sub {
    send_message('oops');
    $mw->g_destroy();
});

Tkx::grid($label, -row => 0, -column => 0, -sticky => 'ew', -padx => 4, -pady => 4);
Tkx::grid($msg_e, -row => 1, -column => 0, -sticky => 'ew', -padx => 4, -pady => 4);
Tkx::grid($msg_b, -row => 1, -column => 1, -sticky => 'ew', -padx => 4, -pady => 4);
Tkx::grid($copy,  -row => 2, -column => 0, -sticky => 'se', -padx => 4, -pady => 4,
                  -columnspan => 2);

Tkx::grid(rowconfigure    => $mw, 2, -weight => 1);
Tkx::grid(columnconfigure => $mw, 0, -weight => 1);

Tkx::MainLoop();
1;

# TclEval - имя службы DDE для Tcl
sub send_message {
    my ($key, $val) = @_;
    return if !defined $key;
    
    eval {
        my $value = $val || q{};
        Tkx::dde_execute(TclEval => 'PerlDDE', "$key {$value}");  
    };
}

Ссылки:

http://en.wikipedia.org/wiki/Dynamic_Data_Exchange
http://tmml.sourceforge.net/doc/tcl/dde.html

PS:

Используйте DDE для тестирования приложений под Windows, работы с Explorer, Internet Explorer, Firefox…
В больших проектах лучше Win32::OLE, DBus.

В будущем DDE возможно выпилят :)