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 require 5.000;
  21
  22 #####################
  23 # Funktionsexport
  24 #####################
  25
  26 require Exporter;
  27 @Id::ISA = qw(Exporter);
  28 @Id::EXPORT = qw(unique_id);
  29
  30 use vars qw(@table);
  31
  32 ##########################################
  33 # EXPORT                                 #
  34 #                                        #
  35 # sub &unique_id                         #
  36 #                                        #
  37 # Funktion:                              #
  38 #      Rueckgabe der ID                  #
  39 ##########################################
  40
  41 sub unique_id {
  42   my $id;
  43
  44   my $ip=$ENV{'REMOTE_ADDR'};
  45   my $time=time();
  46   my $port=$ENV{'REMOTE_PORT'};
  47   my $rand=int(rand(time()));
  48   $ip =  hex(join ('',map {sprintf ('%02X',$_)} split (/\./,$ip)));
  49
  50   join '',map {to_base64 ($_)} (substr ($time,-9), $port, $ip, $rand, $$);
  51 }
  52
  53 sub to_base64 ($) {
  54   my $x = shift;
  55   my $y = $table[$x % 64];
  56
  57   while ($x = int ($x/64)) {$y = $table[$x % 64] . $y}
  58
  59   # Rueckgabe
  60   $y;
  61 }
  62
  63 BEGIN {
  64   srand(time()^$$);
  65   @table = ('a'..'z','-','0'..'9','A'..'Z','_');
  66 }
  67
  68 # making 'require' happy
  69 1;
  70
  71 #####################
  72 # end of Id
  73 #####################