libopensrs-perl 3.0.0-1 / usr / share / perl5 / NAMEPREP.pm

package NAMEPREP;

$VERSION = '3';

use strict;
use CHARLINT;
use Unicode::String qw(utf8 uchr);

Unicode::String->stringify_as('utf8');

my %RACESETTINGS;

sub Initialise
{
	my %args = @_;
	%RACESETTINGS=%args;		
}

sub nameprep
{
	my %args = @_;
	my $name = $args{name};
	my (%result,$i,$ChalintHash,$ProhibReturnHash,$mapresulthash);
	
	$result{hexin}=HexOut($name);

	$mapresulthash = DoMap($name);
	if(defined $mapresulthash->{error})
	{
		$result{error} = $mapresulthash->{error};
		return \%result;
	}
		
	$result{mapoutput} = $mapresulthash->{result};
	
	$result{hexmapoutput} = HexOut($result{mapoutput});

	for($i = 0; $i < length($result{mapoutput}); $i++) {
                if(ord(substr($result{mapoutput}, $i, 1)) == 0)
                        { $result{error} = "Null characters not allowed in normalization"; return \%result; }
        }
	$ChalintHash = CHARLINT::Charlint(Name=> $result{mapoutput}, DataFile=> $RACESETTINGS{DATAFILE});	
	if(defined $ChalintHash->{error})
	{
		$result{error} = $ChalintHash->{error};
		return \%result;
	}

	$result{normalizationout} = $ChalintHash->{charlint_domain};
		
	$result{hexnormalizationout} = HexOut($result{normalizationout});	

	$ProhibReturnHash = CheckForProhib(name => $result{normalizationout},
				       doUnass => 0,
				       unassFile => $RACESETTINGS{UNASSFILE},
				       prohibFile =>$RACESETTINGS{PROHIBFILE});
	if(defined $ProhibReturnHash->{error}) 
	{
		$result{error} = $ProhibReturnHash->{error};
                return \%result;
	}
	elsif($ProhibReturnHash->{result} == 1)
	{
		$result{error} = "Found Prohibited Chars: " . $ProhibReturnHash->{prohib_chars};	
               	return \%result;
	}

	$result{output} = $result{normalizationout};
	$result{hexoutput} = $result{hexnormalizationout};
	return \%result;
}

sub HexOut
{
	my $Temp = shift(@_);
	my (@UTF8Parts, $ThisUTF8Part,$result);
	@UTF8Parts = unpack( 'U0U*', $Temp);
	foreach $ThisUTF8Part (@UTF8Parts) 
	{
		$result .= 'U+' . sprintf('%04lX', $ThisUTF8Part) . ' ';
	}
	return $result;
}

sub DoMap {
        my $ToBeMap = shift(@_);
        my ($i, $TheLine, %MapTable, $From, $To, @AllInOrds);
        my ($ThisOrd, @OutParts, $Part, $OutMap,$Reason,%result);
        #if(!open(MAPFILE, '/home/tlovasic/NEWRACE/MapData-01.txt')) 
        if(!open(MAPFILE, $RACESETTINGS{MAPFILE})) 
	{
		$result{error} = "Could not read " .  $RACESETTINGS{MAPFILE} . " during mapping.";
		return \%result;
	}
        while(<MAPFILE>) {
                $TheLine = $_; chomp($TheLine);
                ($From, $To, $Reason) = split(/; /, $TheLine);
                $Reason = '';  # Needed to avoid the -w warning
                $MapTable{hex($From)} = $To;
        }
        @AllInOrds = unpack('U0U*', $ToBeMap);
        foreach $ThisOrd (@AllInOrds) {
                if(exists($MapTable{$ThisOrd})) {
                        # The mapping may be zero, one, or more encoded hex values
                        @OutParts = split(/ /, $MapTable{$ThisOrd});
                        foreach $Part (@OutParts) {
                                $OutMap .= uchr(hex($Part))->as_string;
                        }
                } else {  # No map, so just put out the character
                        $OutMap .= uchr($ThisOrd)->as_string;
                }
        }
	$result{result} = $OutMap;
        return \%result;
}

sub CheckForProhib {
	my %args = @_;
        my $ProhibCheckString = $args{name};
	my $DoUnass = $args{doUnass};
	my $UnassignedFile = $args{unassFile};
	my $ProhibFile = $args{prohibFile};
        my ($DebugTemp, $TheLine, @InputLines,$InRange, $Left, %ProhibHash, $ThisOrd,@AllInOrds,$FmtString);
	my ($FoundProhib,$Val, $Low, $High, @AllInChars, $i, $ThisChar, $ThisHex,%result);
        # Both the file with unassigned characters and the nameprep draft
        #     have lines in the same format: either they are a hex value,
        #     or they are two hex values with a dash between (indicating a range).
 
        # Only add in the unassigned characters if needed.
        if($DoUnass == 1) {
                if(! open(UNASSIGNED, $UnassignedFile))
		{
			$result{error} = "Could not read from $UnassignedFile\n";
			return \%result;
		}
                while(<UNASSIGNED>) {
                        $TheLine = $_; chomp($TheLine);
                        push(@InputLines, $TheLine);
                }
        }
 
        if(! open(PROHIBIN, $ProhibFile)) 
	{
		$result{error} = "Could not read from $ProhibFile\n";
                return \%result;
	}
        # Load the input array
        while(<PROHIBIN>) {
                $TheLine = $_; chomp($TheLine);
                next if($TheLine eq '');  # Skip blank lines
                push(@InputLines, $TheLine);
        }
 
        # Make a hash of values from the two files
        foreach $InRange (@InputLines) {
                ($Left) = split(/\s+/, $InRange, 2);
                if( (length($Left) == 4) or (length($Left) == 6) )
                        { $ProhibHash{hex($Left)} = 1 }
                else {
                        ($Low, $High) = split('-', $Left);
                        foreach $Val (hex($Low) .. hex($High))
                                { $ProhibHash{$Val} = 1 }
                }
        }
 
        # Compare the characters in the input against the values in
        #    the ProhibHash.
	 @AllInOrds = unpack('U0U*', $ProhibCheckString);
        foreach $ThisOrd (@AllInOrds) {
                if(exists($ProhibHash{$ThisOrd})) {
                        $FmtString = '%04lX';
                        $ThisHex = sprintf($FmtString, $ThisOrd);
                        $result{prohib_chars} .=  $ThisHex . " ";
                        $FoundProhib = 1;
                }
        }
        if($FoundProhib) {
		$result{result} = 1;
                return \%result;
        } else {
		$result{result} = 0;
                return \%result;
        }
}

return 1;