X-Git-Url: https://git.p6c8.net/selfforum.git/blobdiff_plain/ba659b53059e637777865e646f0f2a6fb7f2988e..c6b8e3075d2fd6cd5ef345aa686a68cc899eb5fe:/selfforum-cgi/shared/Id.pm diff --git a/selfforum-cgi/shared/Id.pm b/selfforum-cgi/shared/Id.pm index 33c0c83..480a57e 100644 --- a/selfforum-cgi/shared/Id.pm +++ b/selfforum-cgi/shared/Id.pm @@ -1,73 +1,87 @@ -# 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 , 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