#!/usr/bin/perl

$Digits = shift( @ARGV );
$base = shift( @ARGV );
$Quiet = shift( @ARGV );
$UseSubSubStrings = shift( @ARGV );
$Version = 4;

$StartBeginning = 1 unless $Version > 2;
$UseSubSubStrings = 1 unless $DontUseSubSubStrings;
$Digits = 4 unless $Digits;
$base = 4 unless $base;

$SubStringMatchInterruptCount = 0;

@Characters = qw/ 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 /;

sub AppendDigit {
    my( @in ) = @_;
    my( @ret ) = ();
    print STDERR "Appending...";
    foreach( @in ) {
	for( $i  = 0; $i < $base; $i++ ) {
	    push( @ret, $_ . $Characters[ $i ] );
	}
    }
    print STDERR "Ok.\n";
    return( @ret );
}

sub SetToString {
    my( $str ) = "{ ";
    foreach ( @_ ) {
	$str .= "$_ ";
    }
    $str .= "}";
    return( $str );
}

sub RemoveFromSet {
    my( $toremove, @Set, @RetSet ) = @_;
    foreach( @Set ) {
	if( $_ ne $toremove ) {
	    push( @RetSet, $_ );
	}
    }
    return( @RetSet );
}

sub FindNextWithPrefix {
    my( $PrefixToFind, @Numbers ) = ( @_ );
    print STDERR "($PrefixToFind)" if ( $Quiet > 3 );
    my( $PostDigitLength ) = $Digits - length( $PrefixToFind);
    foreach( @Numbers ) {
	print STDERR "?" if ( $Quiet > 2 );
	if ( m/^$PrefixToFind(\S{$PostDigitLength})$/ ) {
	    print STDERR "+" if ( $Quiet > 1 );
	    return ($1, $_ );
	}
    }
    if( length( $PrefixToFind ) == 1 || $DontUseSubSubStrings ) {
	my( $it ) = $Numbers[0];
	print STDERR "!" if ( $Quiet > 1 );
	$SubStringMatchInterruptCount++;
	return ( $it, $it );
    } else {
	# we'll try it with one fewer character
	print STDERR "~($PrefixToFind)" if ( $Quiet > 1 );
	if ( $PrefixToFind =~ s/^\S(\S+)$/$1/ ) {
	    return( &FindNextWithPrefix( $PrefixToFind, @Numbers ) );
	} else {
	    die "Oh shit\n";
	}
    }
}

sub AddAnother {
    my( $AddToString, @Numbers ) = @_;
    $QToFind = $Digits - 1;
    $AddToString =~ m/(\S{$QToFind})$/;
    my( $Prefix ) = $1;
    my( $Next, $Whole  ) = &FindNextWithPrefix( $Prefix, @Numbers );
    $AddToString .= $Next;
    @Numbers = &RemoveFromSet( $Whole, @Numbers );
    return( $AddToString, @Numbers );
}

local( @Numbers );  # The global array of number sets.
local( %Numbers );  # The global AA of number flags.

sub doit {
    @Numbers = ( "" );
    for( $x = 0; $x < $Digits; $x++ ) {
	@Numbers = &AppendDigit( @Numbers );
    }
    print "Substrings: ", $#Numbers +1, "\n";
    print "MaxLength: ",( $Digits * ( $#Numbers +1 )), "\n";
    print &SetToString( @Numbers ),"\n";

    my( $MasterString );
    if( $StartBeginning ) {
	$MasterString = shift( @Numbers );
    } else {
	$MasterString = pop( @Numbers );
    }

    print STDERR "Working...";
    while( $#Numbers > -1 ) {
	($MasterString, @Numbers ) = &AddAnother( $MasterString, @Numbers );
    }
    print STDERR "Done.\n";
    print "Length: ", length( $MasterString ), "\n";
    print "SubString Match Interrupts: $SubStringMatchInterruptCount\n";
    print $MasterString, "\n";
}

$| = 1;
&doit;