# 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;

#####################
# Funktionsexport
#####################

use base qw(Exporter);
@Id::EXPORT = qw(unique_id);

use vars qw(@table);

##########################################
# EXPORT                                 #
#                                        #
# sub &unique_id                         #
#                                        #
# Funktion:                              #
#      Rueckgabe der ID                  #
##########################################

# sub unique_id ################################################
#
# composing of an 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)));

  join '',map {to_base64 ($_)} ($time, $port, $ip, $rand, $$);
}

# sub to_base64 ################################################
#
# only converts (max.) 32-bit numbers into a
# system with base 64
# its not the RFC base64 format!
#
sub to_base64 ($) {
  my $x = shift;
  my $y = $table[$x % 64];

  $y = $table[$x % 64].$y while ($x = int ($x/64));

  $y;
}

BEGIN {
  srand(time()^$$);
  @table = ('a'..'z','-','0'..'9','A'..'Z','_');
}

# making 'require' happy
1;

#####################
# end of Id
#####################