-n/a-

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

diff --git a/selfforum-cgi/shared/Id.pm b/selfforum-cgi/shared/Id.pm
index fb51d48925bd0be2525ea5cd9a5e42a51c2c1db4..480a57e2da7ff21179a7f10ca9482e4f3736ff2b 100644 (file)
--- a/selfforum-cgi/shared/Id.pm
+++ b/selfforum-cgi/shared/Id.pm
@@ -1,62 +1,61 @@
-# Id.pm
+package Id;

 
 

-##############################################
-#                                            #
-# Autor: n.d.p. / nd@o3media.de              #
-#                                            #
-# Letze Aenderung: n.d.p. / 2001-01-28       #
-#                                            #
-# ========================================== #
-#                                            #
-# Funktion:                                  #
-#                                            #
-# Bereitsstellen einer einmaligen ID         #
-#                                            #
-##############################################
+################################################################################
+#                                                                              #
+# File:        shared/Id.pm                                                    #
+#                                                                              #
+# Authors:     André Malo <nd@o3media.de>, 2001-05-03                          #
+#                                                                              #
+# Description: compose an unique ID (in CGI context)                           #
+#                                                                              #
+################################################################################

 
 use strict;
 
 use strict;

+use vars qw(
+  @table
+  @EXPORT
+);

 
 

-package Id;
-
-#####################
-# Funktionsexport
-#####################
-
+################################################################################
+#
+# Export
+#

 use base qw(Exporter);
 use base qw(Exporter);

-@Id::EXPORT = qw(unique_id);
-
-use vars qw(@table);
-
-##########################################
-# EXPORT                                 #
-#                                        #
-# sub &unique_id                         #
-#                                        #
-# Funktion:                              #
-#      Rueckgabe der ID                  #
-##########################################
+@EXPORT = qw(
+  unique_id
+  may_id
+);

 
 

-# sub unique_id ################################################
+### sub unique_id () ###########################################################

 #
 #

-# composing of an unique ID...
+# compose an unique ID
+#
+# Params: ~none~
+#
+# Return: Scalar: unique ID

 #
 sub unique_id () {
   my $id;
 
 #
 sub unique_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 ($_)} ($time, $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 ################################################
+### sub to_base64 ($) ##########################################################
+#
+# only converts (max.) 32-bit numbers into a system with base 64

 #
 #

-# only converts (max.) 32-bit numbers into a
-# system with base 64
-# its not the RFC base64 format!
+# Params: $x - number to convert
+#
+# Return: converted number ;-)

 #
 sub to_base64 ($) {
   my $x = shift;
 #
 sub to_base64 ($) {
   my $x = shift;


@@ -68,13 +67,21 @@ sub to_base64 ($) {
 }
 
 BEGIN {
 }
 
 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