# This file was derived from Sort.pm

package Cz::Vnsort;
no locale;
use integer;
use strict;
use Exporter;
use vars qw( @ISA @EXPORT $VERSION $DEBUG );
@ISA = qw( Exporter );

#
@EXPORT = qw( vnsort vncmp init_sort_tab );

$VERSION = '0.68';
$DEBUG = 0;
sub DEBUG	{ $DEBUG; }

#
# The table with sorting definitions.
#

my $def_table;

my @sorttab0 = (
'!',
'"',
'#',
'$',
'%',
'&',
'\'',
'(',
')',
'*',
'+',
',',
'-',
'.',
'/',
'0',
'1',
'2',
'3',
'4',
'5',
'6',
'7',
'8',
'9',
':',
';',
'<',
'=',
'>',
'?',
'@',
'A',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'B',
'C',
'D',
'�',
'E',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'F',
'G',
'H',
'I',
'�',
'�',
'�',
'�',
'�',
'J',
'K',
'L',
'M',
'N',
'O',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'P',
'Q',
'R',
'S',
'T',
'U',
'�',
'�',
'�',
'
',
'',
'�',
'',
'',
'',
'',
'',
'V',
'W',
'X',
'Y',
'',
'',
'',
'',
'',
'Z',
'[',
'\\',
']',
'^',
'_',
'`',
'a',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'b',
'c',
'd',
'�',
'e',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'f',
'g',
'h',
'i',
'�',
'�',
'�',
'�',
'�',
'j',
'k',
'l',
'm',
'n',
'o',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'p',
'q',
'r',
's',
't',
'u',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'�',
'v',
'w',
'x',
'y',
'�',
'�',
'�',
'�',
'�',
'z',
'{',
'|',
'}',
'~'
);

my @sorttab1 = (
'!',
'"',
'#',
'$',
'%',
'&',
'\'',
'(',
')',
'*',
'+',
',',
'-',
'.',
'/',
'0',
'1',
'2',
'3',
'4',
'5',
'6',
'7',
'8',
'9',
':',
';',
'<',
'=',
'>',
'?',
'@',
'Aa',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'Bb',
'Cc',
'Dd',
'��',
'Ee',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'Ff',
'Gg',
'Hh',
'Ii',
'��',
'��',
'��',
'��',
'��',
'Jj',
'Kk',
'Ll',
'Mm',
'Nn',
'Oo',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'��',
'Pp',
'Qq',
'Rr',
'Ss',
'Tt',
'Uu',
'��',
'��',
'��',
'
�',
'�',
'��',
'�',
'�',
'�',
'�',
'�',
'Vv',
'Ww',
'Xx',
'Yy',
'�',
'�',
'�',
'�',
'�',
'Zz',
'[',
'\\',
']',
'^',
'_',
'`',
'{',
'|',
'}',
'~'
);

#
# Conversion table will hold four arrays, one for each pass. They will
# be created on the fly if they are needed. We also need to hold
# information (regexp) about groups of letters that need to be considered
# as one character (ch).
#
my @table = ( );
my @regexp = ( '.', '.', '.', '.' );
my @multiple = ( {}, {}, {}, {} );

#
# Make_table will build sorting table for given level.
#
sub make_table
	{
	my $level = shift;
	@{$table[$level]} = ( undef ) x 256;
	@{$table[$level]}[ord ' ', ord "\t"] = (0, 0);
	my $i = 1;
	my $irow = 0;
	while (defined ${$def_table}[$irow])
		{
		my $def_row = ${$def_table}[$irow];
		next if $level <= 2 and $def_row =~ /^ /;
		while ($def_row =~ /<([cC].*?)>|(.)/sg)
			{
			my $match = $+;
			if ($match eq ' ')
				{
				if ($level == 1)
					{ $i++; }
				}
			else
				{
				if (length $match == 1)
					{ $table[$level][ord $match] = $i; }
				else
					{
					$multiple[$level]{$match} = $i;
					$regexp[$level] = $match . "|" . $regexp[$level];
					}
				if ($level >= 2)
					{ $i++; }
				}
			}
		$i++ if $level < 2;
		}
	continue
		{ $irow++; }
	}

#
# Init the sort tables.
#
sub init_sort_tab { 
    my $icase = shift;
    print STDERR "icase = $icase\n";
    if ($icase == 0) {
        $def_table = \@sorttab0;
    }
    else  {
        $def_table = \@sorttab1;
    }
    for (0 .. 3) {
        make_table($_);
    }
}

#
# Compare two scalar, according to the tables.
#
sub vncmp
	{
	my ($a, $b) = (shift, shift);
	print STDERR "vncmp: $a/$b\n" if DEBUG;
	my ($a1, $b1) = ($a, $b);
	my $level = 0;
	while (1)
		{
		my ($ac, $bc, $a_no, $b_no, $ax, $bx) = ('', '', 0, 0,
			undef, undef);
		if ($level == 0)
			{
			while (not defined $ax and not $a_no)
				{
				$a =~ /$regexp[$level]/sg or $a_no = 1;
				$ac = $&;
				$ax = ( length $ac == 1 ?
					$table[$level][ord $ac]
					: ${$multiple[$level]}{$ac} )
						if defined $ac;
				}
			while (not defined $bx and not $b_no)
				{
				$b =~ /$regexp[$level]/sg or $b_no = 1;
				$bc = $&;
				$bx = ( length $bc == 1 ?
					$table[$level][ord $bc]
					: ${$multiple[$level]}{$bc} )
						if defined $bc;
				}
			}
		else
			{
			while (not defined $ax and not $a_no)
				{
				$a1 =~ /$regexp[$level]/sg or $a_no = 1;
				$ac = $&;
				$ax = ( length $ac == 1 ?
					$table[$level][ord $ac]
					: ${$multiple[$level]}{$ac} )
						if defined $ac;
				}
			while (not defined $bx and not $b_no)
				{
				$b1 =~ /$regexp[$level]/sg or $b_no = 1;
				$bc = $&;
				$bx = ( length $bc == 1 ?
					$table[$level][ord $bc]
					: ${$multiple[$level]}{$bc} )
						if defined $bc;
				}
			}

		print STDERR "level $level: ac: $ac -> $ax; bc: $bc -> $bx ($a_no, $b_no)\n" if DEBUG;

		return -1 if $a_no and not $b_no;
		return 1 if not $a_no and $b_no;
		if ($a_no and $b_no)
			{
			if ($level == 0)
				{ $level = 1; next; }
			last;
			}

		return -1 if ($ax < $bx);
		return 1 if ($ax > $bx);

		if ($ax == 0 and $bx == 0)
			{
			if ($level == 0)
				{ $level = 1; next; }
			$level = 0; next;
			}
		}
	for $level (2 .. 3)
		{
		while (1)
			{
			my ($ac, $bc, $a_no, $b_no, $ax, $bx)
				= ('', '', 0, 0, undef, undef);
			while (not defined $ax and not $a_no)
				{
				$a =~ /$regexp[$level]/sg or $a_no = 1;
				$ac = $&;
				$ax = ( length $ac == 1 ?
					$table[$level][ord $ac]
					: ${$multiple[$level]}{$ac} )
						if defined $ac;
				}
			while (not defined $bx and not $b_no)
				{
				$b =~ /$regexp[$level]/sg or $b_no = 1;
				$bc = $&;
				$bx = ( length $bc == 1 ?
					$table[$level][ord $bc]
					: ${$multiple[$level]}{$bc} )
						if defined $bc;
				}
			
			print STDERR "level $level: ac: $ac -> $ax; bc: $bc -> $bx ($a_no, $b_no)\n" if DEBUG;
			return -1 if $a_no and not $b_no;
			return 1 if not $a_no and $b_no;
			if ($a_no and $b_no)
				{ last; }
			return -1 if ($ax < $bx);
			return 1 if ($ax > $bx);
			}
		}
	return 0;
	}

1;

#
# Cssort does the real thing.
#
sub vnsort
	{ sort { vncmp($a, $b); } @_; }


1;