X-Git-Url: https://git.p6c8.net/selfforum.git/blobdiff_plain/ec35b096491af3d6993be62819090f617f98756b..a267dbbdd7f5d6be2248af064671c0a14cc5e1b8:/selfforum-cgi/shared/CheckRFC.pm diff --git a/selfforum-cgi/shared/CheckRFC.pm b/selfforum-cgi/shared/CheckRFC.pm index 6f8fa49..b000dcf 100644 --- a/selfforum-cgi/shared/CheckRFC.pm +++ b/selfforum-cgi/shared/CheckRFC.pm @@ -17,6 +17,7 @@ use vars qw( @email @EXPORT @ISA + $VERSION ); $v56 = eval q[ @@ -26,6 +27,10 @@ $v56 = eval q[ use Carp qw(croak); +# Version check +# +$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r }; + ################################################################################ # # Export @@ -51,27 +56,30 @@ require Exporter; # # Return: Status code (Bool) # -sub is_URL ($@) { +sub is_URL (;$@) { my ($string, @schemes) = @_; + $string = $_ unless defined $string; + my $scheme; return unless (defined ($string) and length ($string)); @schemes = qw(http) unless (@schemes); @schemes = keys %url if (@schemes == 1 and $schemes[0] eq ':ALL'); - for (@schemes) { - croak "unknown url scheme '$_'" unless exists $url{$_}; - unless (/mailto/) { - return 1 if ($string =~ /$url{$_}/); + for $scheme (@schemes) { + croak "unknown url scheme '$scheme'" unless exists $url{$scheme}; + unless ($scheme =~ /mailto/) { + return 1 if ($string =~ /$url{$scheme}/); } else { - return unless ($string =~ /^mailto:(.+)/); - - if ($_ eq 'mailto') { - return 1 if (is_email ($1)); - } - elsif ($_ eq 'strict_mailto') { - return 1 if (is_email ($1,1)); + if ($string =~ /^mailto:(.+)/) { + + if ($scheme eq 'mailto') { + return 1 if (is_email ($1)); + } + elsif ($scheme eq 'strict_mailto') { + return 1 if (is_email ($1,1)); + } } } } @@ -89,8 +97,11 @@ sub is_URL ($@) { # # Return: Status code (Bool) # -sub is_email ($;$) { +sub is_email (;$$) { my $string = shift; + $string = $_ unless defined $string; + return unless defined $string; + my $strict = shift; # false if any non-ascii chars @@ -99,8 +110,6 @@ sub is_email ($;$) { # remove nested comments 1 while ($string =~ s/\([^()]*\)//g); - #$string =~ s/^\s+//; - #$string =~ s/\s+$//; return ($string =~ /^$email[0]$/) unless $strict;