/usr/share/perl5/Gscan2pdf/Dialog.pm is in gscan2pdf 1.3.9-1.
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 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 | package Gscan2pdf::Dialog;
use warnings;
use strict;
use Gtk2;
use Glib 1.220 qw(TRUE FALSE); # To get TRUE and FALSE
use Gtk2::Gdk::Keysyms;
use Data::Dumper;
use Glib::Object::Subclass Gtk2::Window::,
signals => {
delete_event => \&on_delete_event,
key_press_event => \&on_key_press_event,
},
properties => [
Glib::ParamSpec->uint(
'border-width', # name
'Border width', # nickname
'Border width for vbox', # blurb
0, # min
999, # max
0, # default
[qw/readable writable/] # flags
),
Glib::ParamSpec->boolean(
'hide-on-delete', # name
'Hide on delete', # nickname
'Whether to destroy or hide the dialog when it is dismissed', # blurb
FALSE, # default
[qw/readable writable/] # flags
),
Glib::ParamSpec->object(
'vbox', # name
'VBox', # nickname
'VBox which is automatically added to the Gscan2pdf::Dialog', # blurb
'Gtk2::VBox', # package
[qw/readable writable/] # flags
),
];
our $VERSION = '1.3.9';
my $EMPTY = q{};
sub INIT_INSTANCE {
my $self = shift;
$self->set_position('center-on-parent');
# VBox for window
my $vbox = Gtk2::VBox->new;
$self->add($vbox);
$self->set( 'vbox', $vbox );
return $self;
}
sub SET_PROPERTY {
my ( $self, $pspec, $newval ) = @_;
my $name = $pspec->get_name;
$self->{$name} = $newval;
if ( $name eq 'border_width' ) {
$self->get('vbox')->set( 'border-width', $newval );
}
return;
}
sub on_delete_event {
my ( $widget, $event ) = @_;
if ( $widget->get('hide-on-delete') ) {
$widget->hide;
return Gtk2::EVENT_STOP; # ensures that the window is not destroyed
}
$widget->destroy;
return Gtk2::EVENT_PROPAGATE;
}
sub on_key_press_event {
my ( $widget, $event ) = @_;
if ( $event->keyval !=
$Gtk2::Gdk::Keysyms{Escape} ) ## no critic (ProhibitPackageVars)
{
$widget->signal_chain_from_overridden($event);
return Gtk2::EVENT_PROPAGATE;
}
if ( $widget->get('hide-on-delete') ) {
$widget->hide;
}
else {
$widget->destroy;
}
return Gtk2::EVENT_STOP;
}
sub dump_or_stringify {
my ($val) = @_;
return (
defined $val
? ( ref($val) eq $EMPTY ? $val : Dumper($val) )
: 'undef'
);
}
# Unpaper sometimes throws warning messages including a memory address.
# As the address is very rarely the same, although the message itself is,
# filter out the address from the message
sub filter_message {
my ($message) = @_;
$message =~ s{^(.*) # start of message
0x[[:xdigit:]]+ # hex address
(.*)$ # rest of message
}{$1%%x$2}xsm;
return $message;
}
1;
__END__
|