/usr/lib/perl5/Xacobeo/UI/XPathEntry.pm is in xacobeo 0.13-2build1.
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 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 | package Xacobeo::UI::XPathEntry;
=head1 NAME
Xacobeo::UI::XPathEntry - XPath text entry
=head1 SYNOPSIS
use Xacobeo::UI::XPathEntry;
my $entry = Xacobeo::UI::XPathEntry->new();
my $markup = sprintf '<span color="grey" size="smaller">%s</span>',
escape_xml_text(__("XPath Expression..."))
;
$entry->set_empty_markup($markup);
# Must set a document in order to find the namespaces that are allowed
$entry->set_document($document);
if ($entry->is_valid) {
my $xpath = $entry->get_text
my $node = $document->find($xpath);
$result_view->load_node($node);
}
=head1 DESCRIPTION
A text entry that validates XPath expressions. This widget is a
L<Gtk2::Ex::Entry::Pango>.
The widget validates the text in realtime. In order to support validation for
namespaces a document has to be set first.
=head1 PROPERTIES
The following properties are defined:
=head2 document
The document being displayed.
=head2 valid
Indicates if the XPath expression beind displayed is valid based on the current
document.
=head1 METHODS
The following methods are available:
=head2 new
Creates a new instance. This is simply the parent's constructor.
=cut
use strict;
use warnings;
use Data::Dumper;
use Glib qw(TRUE FALSE);
use Gtk2;
use Gtk2::Ex::Entry::Pango;
use Xacobeo::GObject;
Xacobeo::GObject->register_package('Gtk2::Ex::Entry::Pango' =>
properties => [
Glib::ParamSpec->object(
'document',
"Document",
"The main document being displayed",
'Xacobeo::Document',
['readable', 'writable'],
),
Glib::ParamSpec->boolean(
'valid',
"Valid XPath",
"Indicates if the XPath expression is valid",
FALSE,
['readable', 'writable'],
),
],
# FIXME perhaps this signal should be removed and the caller shoud connect to notify::is-valid
signals => {
'xpath-changed' => {
flags => ['run-last'],
# Parameters: XPath expression, isValid
param_types => ['Glib::String', 'Glib::Boolean'],
},
},
);
sub INIT_INSTANCE {
my $self = shift;
$self->signal_connect('changed' => \&callback_changed);
$self->set_sensitive(FALSE);
}
=head2 set_document
Sets a the widget's document. A document is needed in order to provide the
namespaces that allowed in the XPath expression.
Parameters:
=over
=item * $document
The main document; an instance of L<Xacobeo::Document>.
=back
=cut
sub set_document {
my $self = shift;
my ($document) = @_;
$self->document($document);
$self->set_sensitive($document ? TRUE : FALSE);
# FIXME changing the document has to trigger a revalidation of the xpath expression
}
sub callback_changed {
my ($self) = @_;
my $xpath = $self->get_text;
my $document = $self->document;
my $is_valid = FALSE;
if ($document && $xpath) {
$is_valid = $document->validate($xpath);
if (! $is_valid) {
# Mark the XPath expression as wrong
my $escaped = Glib::Markup::escape_text($xpath);
my $markup = "<span underline='error' underline_color='red'>$escaped</span>";
$self->set_markup($markup);
$self->signal_stop_emission_by_name('changed');
}
}
$self->valid($is_valid);
$self->signal_emit('xpath-changed' => $xpath, $is_valid);
}
=head2 is_valid
Returns C<TRUE> if the current XPath expression is valid.
=cut
sub is_valid {
my $self = shift;
return $self->valid;
}
# A true value
1;
=head1 AUTHORS
Emmanuel Rodriguez E<lt>potyl@cpan.orgE<gt>.
=head1 COPYRIGHT AND LICENSE
Copyright (C) 2008,2009 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
|