MercurialSymaptic / file revision
summary | shortlog | changelog | graph | tags | bookmarks | branches | files | changeset | file | latest | revisions | annotate | diff | raw | help
os/textandloc/charconvfw/charconv_fw/tools/WRITER.PM
author sl
Tue, 10 Jun 2014 14:32:02 +0200
changeset 1 260cb5ec6c19
permissions -rw-r--r--
Update contrib. 
     1 #

     2 # Copyright (c) 1997-2009 Nokia Corporation and/or its subsidiary(-ies).

     3 # All rights reserved.

     4 # This component and the accompanying materials are made available

     5 # under the terms of "Eclipse Public License v1.0"

     6 # which accompanies this distribution, and is available

     7 # at the URL "http://www.eclipse.org/legal/epl-v10.html".

     8 #

     9 # Initial Contributors:

    10 # Nokia Corporation - initial contribution.

    11 #

    12 # Contributors:

    13 #

    14 # Description: 

    15 #

    16 

    17 use strict;

    18 use integer;

    19 use FindBin;

    20 

    21 package WRITER;

    22 require Exporter;

    23 @WRITER::ISA=qw(Exporter);

    24 @WRITER::EXPORT=qw(write8 write16 write32 writePositiveIntegerCompacted15 writePositiveIntegerCompacted30 writeSignedIntegerCompacted29 writeString writeUids);

    25 

    26 sub write8

    27 	{

    28 	my $fileHandle=shift;

    29 	my $integer=shift;

    30 	if ($integer&0xffffff00)

    31 		{

    32 		die("Error: the integer ".sprintf("0x%08x", $integer)." is too large to write into 8 bits\n");

    33 		}

    34 	printf $fileHandle "%c", $integer;

    35 	}

    36 

    37 sub write16 # little-endian

    38 	{

    39 	my $fileHandle=shift;

    40 	my $integer=shift;

    41 	if ($integer&0xffff0000)

    42 		{

    43 		die("Error: the integer ".sprintf("0x%08x", $integer)." is too large to write into 8 bits\n");

    44 		}

    45 	&write8($fileHandle, $integer&0x000000ff);

    46 	&write8($fileHandle, ($integer>>8)&0x000000ff);

    47 	}

    48 

    49 sub write32 # little-endian

    50 	{

    51 	my $fileHandle=shift;

    52 	my $integer=shift;

    53 	&write8($fileHandle, $integer&0x000000ff);

    54 	&write8($fileHandle, ($integer>>8)&0x000000ff);

    55 	&write8($fileHandle, ($integer>>16)&0x000000ff);

    56 	&write8($fileHandle, ($integer>>24)&0x000000ff);

    57 	}

    58 

    59 sub writePositiveIntegerCompacted15 # big-endian

    60 	{

    61 	my $fileHandle=shift;

    62 	my $integer=shift;

    63 	if ($integer<0)

    64 		{

    65 		die("Error: the integer ".sprintf("0x%08x", $integer)." is negative\n");

    66 		}

    67 	if ($integer<0x00000080)

    68 		{

    69 		&write8($fileHandle, $integer);

    70 		}

    71 	elsif ($integer<0x00008000)

    72 		{

    73 		&write8($fileHandle, 0x00000080|(($integer>>8)&0x0000007f));

    74 		&write8($fileHandle, $integer&0x000000ff);

    75 		}

    76 	else

    77 		{

    78 		die("Error: the integer ".sprintf("0x%08x", $integer)." is too large to write into 15 bits\n");

    79 		}

    80 	}

    81 

    82 sub writePositiveIntegerCompacted30 # big-endian

    83 	{

    84 	my $fileHandle=shift;

    85 	my $integer=shift;

    86 	if ($integer<0)

    87 		{

    88 		die("Error: the integer ".sprintf("0x%08x", $integer)." is negative\n");

    89 		}

    90 	if ($integer<0x00000080)

    91 		{

    92 		&write8($fileHandle, $integer);

    93 		}

    94 	elsif ($integer<0x00004000)

    95 		{

    96 		&write8($fileHandle, 0x00000080|(($integer>>8)&0x0000003f));

    97 		&write8($fileHandle, $integer&0x000000ff);

    98 		}

    99 	elsif ($integer<0x40000000)

   100 		{

   101 		&write8($fileHandle, 0x000000c0|(($integer>>24)&0x0000003f));

   102 		&write8($fileHandle, ($integer>>16)&0x000000ff);

   103 		&write8($fileHandle, ($integer>>8)&0x000000ff);

   104 		&write8($fileHandle, $integer&0x000000ff);

   105 		}

   106 	else

   107 		{

   108 		die("Error: the integer ".sprintf("0x%08x", $integer)." is too large to write into 30 bits\n");

   109 		}

   110 	}

   111 

   112 sub writeSignedIntegerCompacted29 # big-endian

   113 	{

   114 	my $fileHandle=shift;

   115 	my $integer=shift;

   116 	my $negativeFlag=0x00000000;

   117 	if ($integer<0)

   118 		{

   119 		$negativeFlag=0x00000080;

   120 		if (($integer^-$integer)==0)

   121 			{

   122 			die("Error: the integer ".sprintf("0x%08x", $integer)." is too large to write into 29 bits\n");

   123 			}

   124 		$integer=-$integer;

   125 		}

   126 	if ($integer<0x00000040)

   127 		{

   128 		&write8($fileHandle, $negativeFlag|$integer);

   129 		}

   130 	elsif ($integer<0x00002000)

   131 		{

   132 		&write8($fileHandle, $negativeFlag|0x00000040|(($integer>>8)&0x0000001f));

   133 		&write8($fileHandle, $integer&0x000000ff);

   134 		}

   135 	elsif ($integer<0x20000000)

   136 		{

   137 		&write8($fileHandle, $negativeFlag|0x00000060|(($integer>>24)&0x0000001f));

   138 		&write8($fileHandle, ($integer>>16)&0x000000ff);

   139 		&write8($fileHandle, ($integer>>8)&0x000000ff);

   140 		&write8($fileHandle, $integer&0x000000ff);

   141 		}

   142 	else

   143 		{

   144 		die("Error: the integer ".sprintf("0x%08x", $integer)." is too large to write into 30 bits\n");

   145 		}

   146 	}

   147 

   148 sub writeString

   149 	{

   150 	my $fileHandle=shift;

   151 	my $string=shift;

   152 	my $lengthOfString=length($string);

   153 	my $i;

   154 	for ($i=0; $i<$lengthOfString; ++$i)

   155 		{

   156 		my $byteAsNumber;

   157 		($byteAsNumber)=unpack("C", substr($string, $i, 1));

   158 		&write8($fileHandle, $byteAsNumber);

   159 		}

   160 	}

   161 

   162 sub writeUids

   163 	{

   164 	my $fileHandle=shift;

   165 	my $uid1=shift;

   166 	my $uid2=shift;

   167 	my $uid3=shift;

   168 	use Cwd;

   169 	my $uidsin = sprintf("0x%08x 0x%08x 0x%08x ", $uid1, $uid2, $uid3);

   170 

   171 	# Locate uidcrc on the same path as this module, and if not found then run through environment

   172 

   173   	my $uidsout = "";

   174   	my $uidlocation = "$FindBin::Bin/uidcrc";

   175   	if(-e $uidlocation or -e $uidlocation.".exe") {

   176 		$uidsout = `$uidlocation $uidsin` or die('Error: could not find UIDCRC at '.$uidlocation ); }

   177 	else {

   178 		$uidsout = `uidcrc $uidsin` or die('Error: could not find UIDCRC on PATH');

   179 	}

   180 

   181 	die ('Did not understand output of UIDCRC')

   182 		unless $uidsout =~ /^0x([0-9a-fA-F]{8}) 0x([0-9a-fA-F]{8}) 0x([0-9a-fA-F]{8}) 0x([0-9a-fA-F]{8})[ \n\r\t]*$/s;

   183 	my $uidCrcBinaryBuffer = pack 'V4', hex($1), hex($2), hex($3), hex($4);

   184 	&writeString($fileHandle, $uidCrcBinaryBuffer);

   185 	}

   186
Symaptic