Use Custom Fields to check EmailList, IP address and Regexp

mantis: 0003081

Build.PL

@@ -45,6 +45,9 @@ my $builder = Local::Module::Build->new(
         'Text::CSV_XS' => 0,
         'DBIx::Class::ResultSet::RecursiveUpdate' => 0.30,
         #patch to set foreign key instead of relation, install from github until its available on cpan
+        'Data::Validate::IP' => 0,
+        'Email::Valid' => 0,
+        'Regexp::Parser' => 0,
     },
     test_requires => {
         'Catalyst::Test' => 0,

lib/NGCP/Panel/Field/EmailList.pm

@@ -0,0 +1,47 @@
+package NGCP::Panel::Field::EmailList;
+use HTML::FormHandler::Moose;
+use Email::Valid;
+use Sipwise::Base;
+extends 'HTML::FormHandler::Field::Text';
+
+sub validate {
+    my ( $self ) = @_;
+    my @emails = $self->value->split(',');
+    for my $mail (@emails) {
+        unless( Email::Valid->address(
+            -address  => $mail,
+            -tldcheck => 0,
+            -mxcheck  => 0,
+            -allow_ip => 1,
+            -fudge    => 0,
+        ) ) {
+            return $self->add_error($mail . " is no valid email address");
+        }
+    }
+    return 1;
+}
+
+1;
+
+=head1 NAME
+
+NGCP::Panel::Field::EmailList
+
+=head1 DESCRIPTION
+
+This accepts a comma (,) separated list of email addresses using
+L<Email::Valid>. It does not check for a valid TLD allows IP addresses for
+the domain part. It subclasses L<HTML::FormHandler::Field::Text>.
+
+=head1 AUTHOR
+
+Gerhard Jungwirth
+
+=head1 LICENSE
+
+This library is free software. You can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+# vim: set tabstop=4 expandtab:

lib/NGCP/Panel/Field/IPAddress.pm

@@ -0,0 +1,36 @@
+package NGCP::Panel::Field::IPAddress;
+use HTML::FormHandler::Moose;
+use Data::Validate::IP qw(is_ipv4 is_ipv6);
+extends 'HTML::FormHandler::Field::Text';
+
+sub validate {
+    my ( $self ) = @_;
+    return $self->add_error($self->label . " is no valid IPv4 or IPv6 address.")
+        unless( is_ipv4($self->value) or is_ipv6($self->value) );
+    return 1;
+}
+
+1;
+
+=head1 NAME
+
+NGCP::Panel::Field::IPAddress
+
+=head1 DESCRIPTION
+
+This accepts a valid IPv4 or IPv6 address (without square brackets).
+For details on the validation see L<Data::Validate::IP>.
+It subclasses L<HTML::FormHandler::Field::Text>.
+
+=head1 AUTHOR
+
+Gerhard Jungwirth
+
+=head1 LICENSE
+
+This library is free software. You can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+# vim: set tabstop=4 expandtab:

lib/NGCP/Panel/Field/Regexp.pm

@@ -0,0 +1,38 @@
+package NGCP::Panel::Field::Regexp;
+use HTML::FormHandler::Moose;
+use Regexp::Parser;
+extends 'HTML::FormHandler::Field::Text';
+
+my $parser = Regexp::Parser->new();
+
+sub validate {
+    my ( $self ) = @_;
+    my $pattern = $self->value;
+    return $self->add_error($self->label . " is no valid regexp")
+        unless $parser->regex($pattern);
+    return 1;
+}
+
+1;
+
+=head1 NAME
+
+NGCP::Panel::Field::Regexp
+
+=head1 DESCRIPTION
+
+This accepts a regexp that can be validated in perl. It subclasses
+L<HTML::FormHandler::Field::Text>.
+
+=head1 AUTHOR
+
+Gerhard Jungwirth
+
+=head1 LICENSE
+
+This library is free software. You can redistribute it and/or modify
+it under the same terms as Perl itself.
+
+=cut
+
+# vim: set tabstop=4 expandtab:

lib/NGCP/Panel/Form/BillingFee.pm

@@ -20,12 +20,12 @@ has_field 'submitid' => (
 );
 
 has_field 'source' => (
-    type => 'Text', #Regexp
+    type => '+NGCP::Panel::Field::Regexp',
     maxlength => 255,
 );
 
 has_field 'destination' => (
-    type => 'Text', #Regexp nonepty
+    type => '+NGCP::Panel::Field::Regexp',
     maxlength => 255,
     required => 1,
 );

lib/NGCP/Panel/Form/BillingProfile.pm

@@ -50,7 +50,7 @@ has_field 'fraud_interval_lock' => (
 );
 
 has_field 'fraud_interval_notify' => (
-    type => 'Text', #Email?
+    type => '+NGCP::Panel::Field::EmailList',
     label => 'Fraud Monthly Notify',
     maxlength => 255,
 );
@@ -71,7 +71,7 @@ has_field 'fraud_daily_lock' => (
 );
 
 has_field 'fraud_daily_notify' => (
-    type => 'Text', #Email?
+    type => '+NGCP::Panel::Field::EmailList',
     maxlength => 255,
 );
 

lib/NGCP/Panel/Form/PeeringRule.pm

@@ -16,11 +16,11 @@ has_field 'callee_prefix' => (
 );
 
 has_field 'callee_pattern' => (
-    type => 'Text',
+    type => '+NGCP::Panel::Field::Regexp',
 );
 
 has_field 'caller_pattern' => (
-    type => 'Text',
+    type => '+NGCP::Panel::Field::Regexp',
 );
 
 has_field 'description' => (

lib/NGCP/Panel/Form/PeeringServer.pm

@@ -17,7 +17,7 @@ has_field 'name' => (
 );
 
 has_field 'ip' => (
-    type => 'Text', #IP Address
+    type => '+NGCP::Panel::Field::IPAddress',
     required => 1,
     label => 'IP Address',
 );