added version checks

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

diff --git a/selfforum-cgi/shared/Id.pm b/selfforum-cgi/shared/Id.pm
index 33c0c83483f89188e63dcd0dedb5f8e486d15396..22535a20bc4ff605b8160d36f4aee3eff5320f39 100644 (file)
--- a/selfforum-cgi/shared/Id.pm
+++ b/selfforum-cgi/shared/Id.pm
@@ -1,73 +1,94 @@
-# Id.pm
-
-##############################################
-#                                            #
-# Autor: n.d.p. / nd@o3media.de              #
-#                                            #
-# Letze Aenderung: n.d.p. / 2001-01-28       #
-#                                            #
-# ========================================== #
-#                                            #
-# Funktion:                                  #
-#                                            #
-# Bereitsstellen einer einmaligen ID         #
-#                                            #
-##############################################
-
-use strict;
-

 package Id;
 package Id;

-require 5.000;
-
-#####################
-# Funktionsexport
-#####################

 
 

-require Exporter;
-@Id::ISA = qw(Exporter);
-@Id::EXPORT = qw(unique_id);
+################################################################################
+#                                                                              #
+# File:        shared/Id.pm                                                    #
+#                                                                              #
+# Authors:     André Malo <nd@o3media.de>, 2001-05-03                          #
+#                                                                              #
+# Description: compose an unique ID (in CGI context)                           #
+#                                                                              #
+################################################################################

 
 

-use vars qw(@table);
-
-##########################################
-# EXPORT                                 #
-#                                        #
-# sub &unique_id                         #
-#                                        #
-# Funktion:                              #
-#      Rueckgabe der ID                  #
-##########################################
-
-sub unique_id {
+use strict;
+use vars qw(
+  @table
+  @EXPORT
+  $VERSION
+);
+
+################################################################################
+#
+# Version check
+#
+$VERSION = do { my @r =(q$Revision$ =~ /\d+/g); sprintf "%d."."%02d" x $#r, @r };
+
+################################################################################
+#
+# Export
+#
+use base qw(Exporter);
+@EXPORT = qw(
+  unique_id
+  may_id
+);
+
+### sub unique_id () ###########################################################
+#
+# compose an unique ID
+#
+# Params: ~none~
+#
+# Return: Scalar: unique ID
+#
+sub unique_id () {

   my $id;
 
   my $id;
 

-  my $ip=$ENV{'REMOTE_ADDR'};
-  my $time=time();
-  my $port=$ENV{'REMOTE_PORT'};
-  my $rand=int(rand(time()));
-  $ip =  hex(join ('',map {sprintf ('%02X',$_)} split (/\./,$ip)));
+  my $ip=$ENV{REMOTE_ADDR};
+  my $time=time;
+  my $port=$ENV{REMOTE_PORT};
+  my $rand=int(rand(time));

 
 

-  join '',map {to_base64 ($_)} (substr ($time,-9), $port, $ip, $rand, $$);
+  # works only with IPv4! (will be changed later...)
+  #
+  $ip = hex(join ('',map {sprintf ('%02X',$_)} split (/\./,$ip)));
+
+  join '' => map {to_base64 ($_)} ($time, $port, $ip, $rand, $$);

 }
 
 }
 

+### sub to_base64 ($) ##########################################################
+#
+# only converts (max.) 32-bit numbers into a system with base 64
+#
+# Params: $x - number to convert
+#
+# Return: converted number ;-)
+#

 sub to_base64 ($) {
   my $x = shift;
   my $y = $table[$x % 64];
 
 sub to_base64 ($) {
   my $x = shift;
   my $y = $table[$x % 64];
 

-  while ($x = int ($x/64)) {$y = $table[$x % 64] . $y}
+  $y = $table[$x % 64].$y while ($x = int ($x/64));

 
 

-  # Rueckgabe

   $y;
 }
 
 BEGIN {
   $y;
 }
 
 BEGIN {

-  srand(time()^$$);
+  # 64 'digits' (for our base 64 system)
+  #

   @table = ('a'..'z','-','0'..'9','A'..'Z','_');
   @table = ('a'..'z','-','0'..'9','A'..'Z','_');

+
+  # define sub may_id
+  #
+  *may_id = eval join quotemeta join ('' => @table) => (
+    q[sub {local $_=shift; defined and length and not y/],
+    q[//cd;}]
+  );

 }
 
 }
 

-# making 'require' happy
+# keep 'require' happy

 1;
 
 1;
 

-#####################
-# end of Id
-#####################
\ No newline at end of file
+#
+#
+### end of Id ##################################################################
\ No newline at end of file