selfforum-cgi/shared/Id.pm

   1 # Id.pm
   2
   3 ##############################################
   4 #                                            #
   5 # Autor: n.d.p. / nd@o3media.de              #
   6 #                                            #
   7 # Letze Aenderung: n.d.p. / 2001-01-28       #
   8 #                                            #
   9 # ========================================== #
  10 #                                            #
  11 # Funktion:                                  #
  12 #                                            #
  13 # Bereitsstellen einer einmaligen ID         #
  14 #                                            #
  15 ##############################################
  16
  17 use strict;
  18
  19 package Id;
  20
  21 #####################
  22 # Funktionsexport
  23 #####################
  24
  25 use base qw(Exporter);
  26 @Id::EXPORT = qw(unique_id);
  27
  28 use vars qw(@table);
  29
  30 ##########################################
  31 # EXPORT                                 #
  32 #                                        #
  33 # sub &unique_id                         #
  34 #                                        #
  35 # Funktion:                              #
  36 #      Rueckgabe der ID                  #
  37 ##########################################
  38
  39 # sub unique_id ################################################
  40 #
  41 # composing of an unique ID...
  42 #
  43 sub unique_id () {
  44   my $id;
  45
  46   my $ip=$ENV{'REMOTE_ADDR'};
  47   my $time=time();
  48   my $port=$ENV{'REMOTE_PORT'};
  49   my $rand=int(rand(time()));
  50   $ip =  hex(join ('',map {sprintf ('%02X',$_)} split (/\./,$ip)));
  51
  52   join '',map {to_base64 ($_)} ($time, $port, $ip, $rand, $$);
  53 }
  54
  55 # sub to_base64 ################################################
  56 #
  57 # only converts (max.) 32-bit numbers into a
  58 # system with base 64
  59 # its not the RFC base64 format!
  60 #
  61 sub to_base64 ($) {
  62   my $x = shift;
  63   my $y = $table[$x % 64];
  64
  65   $y = $table[$x % 64].$y while ($x = int ($x/64));
  66
  67   $y;
  68 }
  69
  70 BEGIN {
  71   srand(time()^$$);
  72   @table = ('a'..'z','-','0'..'9','A'..'Z','_');
  73 }
  74
  75 # making 'require' happy
  76 1;
  77
  78 #####################
  79 # end of Id
  80 #####################