view release on metacpan or  search on metacpan

t/test-applet  view on Meta::CPAN

#!/opt/perl-5.10.1/bin/perl
# -*- coding: utf-8 -*-

# Uncomment and modify this and the shebang above if you have the Perl modules
# in a custom directory and the panel's environment isn't set up so that perl
# can find them.
use lib qw(/opt/perl-5.10.1-lib/lib/perl5);

use strict;
use warnings;
use utf8;

use Test::More qw(no_plan);

use Glib qw(:constants);
use Gnome2::PanelApplet;

Gnome2::Program->init ('Perl Test Applet', '0.01', 'libgnomeui',
                       sm_connect => FALSE);

Gnome2::PanelApplet::Factory->main ('OAFIID:PerlTestApplet_Factory',
                                    'Gnome2::PanelApplet',
                                    \&fill);

sub fill {
  my ($applet, $iid, $data) = @_;

  if ($iid ne 'OAFIID:PerlTestApplet') {
    return FALSE;
  }

  my $menu_xml = <<EOX;
<popup name="button3">
  <menuitem name="TestUno Item" verb="TestUno" _label="Test I ..."/>
  <menuitem name="TestDos Item" verb="TestDos" _label="Test II ..."/>
  <menuitem name="TestTres Item" verb="TestTres" _label="Test III ..."/>
  <menuitem name="TestCuatro Item" verb="TestCuatro" _label="Test IV ..."/>
  <menuitem name="TestCinco Item" verb="TestCinco" _label="Test V ..."/>
</popup>
EOX

  my $cb_mapping = {
    TestUno => [\&test_one, 'default!'],
    TestDos => \&test_two,
    TestTres => \&test_three,
    TestCuatro => \&test_four,
    TestCinco => \&test_five,
  };

  $applet->setup_menu($menu_xml, $cb_mapping, $applet);

  my $label = Gtk2::Label->new ('Run the tests from the context menu, please');
  $applet->add ($label);
  $applet->show_all;

  return TRUE;
}

sub _setup_output {
  my ($fh) = @_;
  my $output;
  open $fh, '>', \$output;
  Test::More->builder->output($fh);
  Test::More->builder->failure_output($fh);
  Test::More->builder->todo_output($fh);
  return \$output;
}

sub _show_results {
  my ($output) = @_;

  my $buffer = Gtk2::TextBuffer->new;
  $buffer->insert_at_cursor ($output);

  my $view = Gtk2::TextView->new_with_buffer ($buffer);
  my $window = Gtk2::ScrolledWindow->new;
  $window->add ($view);

  my $dialog = Gtk2::Dialog->new ('Test Output', undef, [], 'gtk-ok' => 'ok');
  $dialog->vbox->add ($window);
  $dialog->set_default_size (400, 400);
  $dialog->show_all;
  $dialog->run;
  $dialog->destroy;
}

sub test_one {
  my ($component, $data, $verb) = @_;

  my $output_ref = _setup_output (my $fh);

  is ($component, undef, 'component == undef');
  is ($data, 'default!', 'data as expected');
  is ($verb, 'TestUno', 'verb as expected');

  _show_results ($$output_ref);
}

sub test_two {