modified version check

[selfforum.git] / selfforum-cgi / shared / CheckRFC.pm

diff --git a/selfforum-cgi/shared/CheckRFC.pm b/selfforum-cgi/shared/CheckRFC.pm
index 6f8fa49d61bfc5bc92f2b4c6a429b2667021cb1c..b000dcff7f737918538be98882ee8daac16e0bef 100644 (file)
--- 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;