view release on metacpan or  search on metacpan

Redbase/DataStream.pm  view on Meta::CPAN

	return sprintf("%02d:%02d:%02d", $time[2], $time[1], $time[0]);
}

sub readTimestamp($)
{
	my $this = shift;
	my $stamp;
	my $nanos;
	my @time;

	$stamp = $this->readLong();
	$nanos = $this->readInt();
	
	#Since number is in milliseconds and not seconds
	@time = localtime(substr($stamp, 0, length($stamp) - 3));

	return sprintf("%04d-%02d-%02d %02d:%02d:%02d.%d",
		($time[5] + 1900),
		($time[4] + 1),
		$time[3],
		$time[2],
		$time[1],
		$time[0],
		$nanos);
}

sub readByteArray($)
{
	my $this = shift;
	my $buf;
	my $size;

	$size = $this->readInt();
	$FHIN->read($buf, $size);

	$byte_count += $size;

	return $buf;
}

sub readDecimal($)
{
	my $this = shift;
	my $bytes;
	my $scale;

	return _readDecimal($this->readByteArray(), $this->readInt());

}

###############################################################################
#                 PRIVATE FUNCTIONS
###############################################################################

###############################################################################
# This function return string compatible with with javas Input/OutputStream
# readUTF method
###############################################################################
sub _writeUTF($)
{
	my $unicode_string = utf8(shift());
	while ((my $pos = index($unicode_string, "\000")) > -1)
	{
		$unicode_string = substr($unicode_string, 0, $pos) . chr(192) . chr(128) . substr($unicode_string, $pos + 1);
	}
	return $unicode_string;
}

###############################################################################
# This method writes binary char compatible with Java
###############################################################################
sub _writeChar($)
{
	my $u = new Unicode::String(shift());
	my $f = $u->hex();
	
	#Chopping to have only a single char
	$f =~ s/ .*$//;
	$f =~ s/^U\+/0x/;
	return _writeShort(oct($f));
}

###############################################################################
# This method writes binary boolean compatible with Java
###############################################################################
sub _writeBoolean($)
{
	my $b = shift();
	if ((!defined($b)) || ($b == 0) || ($b =~ /^false$/i))
	{
		return pack("x");
	}
	else
	{
		return pack("C", 0x01);
	}
}

###############################################################################
# This method writes binary byte compatible with Java
###############################################################################
sub _writeUnsignedByte($)
{
	return _writeByte(shift());
}

###############################################################################
# This method writes binary byte compatible with Java
###############################################################################
sub _writeByte($)
{
	my $i = int(shift());

	#Chopping integer if too big
	if ($i > 0xff)
	{
		$i = $i & 0xff;
	}

	return pack("C", $i);
}

###############################################################################
# This method writes binary short compatible with Java
###############################################################################
sub _writeShort($)

Redbase/DataStream.pm  view on Meta::CPAN

	else
	{
		#if sign is negative sprintf will produce it
		$sign = "-"
	}

	$number =~ s/^\+//;
	$number =~ s/^-//;

	if ($number =~ /E/)
	{
		$exp = $number;
		$exp =~ s/[+,-]*[0-9,.]+E//;
		$exp =~ s/^\+0*//;
		$exp =~ s/^-0*/-/;
		$mantissa = $number;
		$mantissa =~ s/E.*$//;
	}
	else
	{
		$exp = 0;
		$mantissa = $number;
	}

	$mantissa .= "." if (!($mantissa =~ /\./));
	$mantissa = "0" . $mantissa if ($mantissa =~ /^\./);

	$index = index($mantissa, '.');
	if ($index != 1)
	{
		$exp += $index - 1;
	}
	$mantissa =~ s/\.//;

	if ($mantissa =~ /^0+$/)
	{
		$mantissa = 0;
	}
	elsif ($mantissa =~ /^0/)
	{
		while($mantissa =~ /^0/)
		{
			$exp -= 1;
			$mantissa =~ s/^0//;
		}
	}

	$mantissa = substr($mantissa, 0, 1) . "." . substr($mantissa, 1);
	$mantissa =~ s/0*$//;

	$number = $sign . $mantissa . "E" . sprintf("%05d", $exp);

	return $number;
}

###############################################################################
# This method converts Java UTF-8 string into current encoding
###############################################################################
sub _readUTF($)
{
	my $unicode_string = utf8(shift());
	while ((my $pos = index($unicode_string, chr(192) . chr(128))) > -1)
	{
		$unicode_string = substr($unicode_string, 0, $pos) . chr(0) . substr($unicode_string, $pos + 2);
	}
	return $unicode_string->latin1();
}

###############################################################################
# This method reads binary char compatible with Java
###############################################################################
sub _readChar($)
{
	return chr(_readShort(shift) & 0x00ff);
}

###############################################################################
# This method reads binary boolean compatible with Java
###############################################################################
sub _readBoolean($)
{
	return unpack("C", shift());
}

###############################################################################
# This method reads binary byte compatible with Java
###############################################################################
sub _readByte($)
{
	return unpack("c", shift());
}

###############################################################################
# This method reads binary unsigned byte compatible with Java
###############################################################################
sub _readUnsignedByte($)
{
	return unpack("C", shift());
}

###############################################################################
# This method reads binary short compatible with Java
###############################################################################
sub _readShort($)
{
	my $i = shift;
	my $a = unpack("C", substr($i,0,1));
	my $b = unpack("C", substr($i,1,1));
	
	#Trick to make perl treat this as signed
	return unpack("s", pack("s", (($a << 8) | ($b & 0xff)))); 
}

###############################################################################
# This method reads binary unsigned short compatible with Java
###############################################################################
sub _readUnsignedShort($)
{
	my $i = shift;
	return (
		((unpack("C", substr($i,0,1)) & 0xff) << 8) |
		 (unpack("C", substr($i,1,1)) & 0xff))
}

###############################################################################
# This method reads binary int compatible with Java