[Fwd: [Html-widget] formfu - new features]

[Mario Minati]

Am Mittwoch 14 März 2007 15:21 schrieb Jason Kohles:
> On Mar 14, 2007, at 4:09 AM, Mario Minati wrote:
> > So this brings me back to my problem to find a constrain that
> > handles the http
> > webadresses a user could type. For me that should include the
> > fragment and
> > doesn't need necessarily the https? scheme.
> >
> > For now I would suggest to make a custom Constraint out of it which
> > doesn't
> > need to be part of the main formfu distribution.
>
> The easiest way to do that would be to build a custom Regexp::Common
> subclass using the pieces that Regexp::Common::URI already provides...

I did that before but the idea was to avoid to many different Constraint 
modules, so we wanted to just use Regexp::Common.

>
>
> package Regexp::Common::WebAddress;
> use strict;
> local $^W = 1;
>
> use Regexp::Common               qw( pattern clean no_defaults );
> use Regexp::Common::URI::RFC2396 qw(
>      $host $port $path_segments $query $fragment
> );
>
> pattern name    => [ qw( WebAddress ) ],
>          create  => "(?k:(?k:https?)://(?k:$host)(?::(?k:$port))?".
>                     "(?k:/(?k:(?k:$path_segments)(?:[?](?k:
> $query))?))?".
>                     "(?k:#$fragment)?)";

I had to make a few adjstments to realy match my requirements:

package Regexp::Common::WebAddress;

use strict;

local $^W = 1;

use Regexp::Common qw( pattern clean no_defaults );
use Regexp::Common::URI::RFC2396 qw( $host $port $path_segments $query 
$fragment $domainlabel $toplabel $IPv4address );

pattern  name    => [ qw( WebAddress ) ],
#          create  => "(?k:(?k:(?k:https?)://)?(?k:$host)(?::(?k:$port))?".
#                     "(?k:/(?k:(?k:$path_segments)(?:[?](?k:$query))?))?".
#                     "(?k:#$fragment)?)";
         create  => "(?k:(?k:https?)://)?".
                    "(?k:(($domainlabel\[.])+($toplabel\[.]?)|$IPv4address))".
                    "(?::(?k:$port))?".
                    "(?k:/(?k:(?k:$path_segments)(?:[?](?k:$query))?
(?k:#$fragment)?))?";

1;

The most important change is + instead of * after $toplabel otherwise every 
scheme is valid with the scheme being optional.

>
> #!/usr/bin/perl -w
> use Regexp::Common qw( WebAddress );
>
> print "$_: ".( /^$RE{WebAddress}$/ ? "VALID" : "NOT VALID" )."\n" for (
>      'http://www.google.com/',
>      'foo://blah.arghh!/',
>      'foo://foo.bar/',
>      'https://minati.de./',
>      'http://minati.de./',
>      'https://minati.de/index.html#lkj',
>      'http://minati.de/index.html#lkj',
> );

This way I achieve that 'www.minati.de' is also valid, which is important for 
me.

Greets,
Mario