-# 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;
-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
+);
+
+################################################################################
+#
+# 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 $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];
- while ($x = int ($x/64)) {$y = $table[$x % 64] . $y}
+ $y = $table[$x % 64].$y while ($x = int ($x/64));
- # Rueckgabe
$y;
}
BEGIN {
- srand(time()^$$);
+ # 64 'digits' (for our base 64 system)
+ #
@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;
-#####################
-# end of Id
-#####################
\ No newline at end of file
+#
+#
+### end of Id ##################################################################
\ No newline at end of file