/usr/lib/perl5/Wx/Perl/TextValidator.pm is in libwx-perl 1:0.9922-2.
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 | #############################################################################
## Name: ext/pperl/textval/TextValidator.pm
## Purpose: Wx::Perl::TextValidator, a perl-ish wxTextValidator
## Author: Johan Vromans, Mattia Barbon
## Modified by:
## Created: 15/08/2005
## RCS-ID: $Id: TextValidator.pm 2057 2007-06-18 23:03:00Z mbarbon $
## Copyright: (c) 2005 Johan Vromans, Mattia Barbon
## Licence: This program is free software; you can redistribute itand/or
## modify it under the same terms as Perl itself
#############################################################################
package Wx::Perl::TextValidator;
=head1 NAME
Wx::Perl::TextValidator - Perl replacement for wxTextValidator
=head1 SYNOPSIS
my $storage = '';
my $validator1 = Wx::Perl::TextValidator->new( '\d', \$storage );
my $validator2 = Wx::Perl::TextValidator->new( '[abcdef]' );
my $validator3 = Wx::Perl::TextValidator->new( qr/[a-zA-Z]/ );
my $textctrl = Wx::TextCtrl->new( $parent, -1, "", $pos, $size, $style,
$validator1 );
=head1 DESCRIPTION
A C<Wx::Validator> subclass that allows filtering user input to
a C<Wx::TextCtrl>.
=head1 METHODS
my $validator1 = Wx::Perl::TextValidator->new( $regexp, \$storage );
my $validator2 = Wx::Perl::TextValidator->new( $regexp );
Constructs a new C<Wx::Perl::Validator>. The first argument must be
a regular expression matching a single-character string and is used
to validate the field contents and user input. The second argument,
if present, is used in TransferDataToWindow/TransferDataToWindow as
the source/destination for the fields contents.
The first argument can be a string as well as a reqular expression
object created using C<qr//>.
=cut
use strict;
use Wx qw(:keycode wxOK wxICON_EXCLAMATION);
use Wx::Event qw(EVT_CHAR);
use Wx::Locale qw(:default);
use base qw(Wx::PlValidator);
our $VERSION = '0.01';
sub new {
my( $class, $validate, $data ) = @_;
my $self = $class->SUPER::new;
$self->{validate} = ref $validate ? $validate : qr/^$validate$/;
$self->{data} = $data;
EVT_CHAR($self, \&OnKbdInput);
return $self;
}
sub OnKbdInput {
my ($self, $event) = @_;
my $c = $event->GetKeyCode;
if( $c < WXK_SPACE || # skip control characters
$c == WXK_DELETE ||
$c > WXK_START ||
$event->HasModifiers # allow Ctrl-C and such
) {
$event->Skip;
} elsif( pack( "C", $c ) =~ $self->{validate} ) {
$event->Skip;
} else {
Wx::Bell;
}
}
sub Clone {
my( $self ) = @_;
return ref( $self )->new( $self->{validate}, $self->{data} );
}
sub Validate {
my( $self, $window ) = @_;
my $value = $self->GetWindow->GetValue;
my $ko = grep { !/$self->{validate}/ }
split //, $value;
if( $ko ) {
Wx::MessageBox( sprintf( gettext( "'%s' is invalid" ), $value ),
gettext( "Validation conflict" ),
wxOK | wxICON_EXCLAMATION, $window );
}
return !$ko;
}
sub TransferToWindow {
my( $self ) = @_;
if( $self->{data} ) {
$self->GetWindow->SetValue( ${$self->{data}} );
}
return 1;
}
sub TransferFromWindow {
my( $self ) = @_;
if( $self->{data} ) {
${$self->{data}} = $self->GetWindow->GetValue;
}
return 1;
}
1;
|