view release on metacpan or  search on metacpan

Buckaroo.pm  view on Meta::CPAN

    my @in_array = split(//, $in_string);
    $out = Dumper(@in_array);
    print("in_array=>>$out<<\n")  if $debug_mode;

    my $i = 0;
    my @temparray = ();
    foreach my $thischar (@in_array)
    {
        # translate each character into it's ascii value.
        my $num = unpack("c", $thischar);
        # change that ascii value into a string from the array...
        my $newchar = $xlate_array[$num];
        print("char=>>$thischar<<, num=>>$num<<, newchar=>>$newchar<<\n")  if $debug_mode;
        print("char=>>%s<<, num=>>%s<<, newchar=>>%s<<\n", $thischar, $num, $newchar)  if $debug_mode;
        push(@temparray, "$newchar");
        $i++;
        if ($i > 3)
        {
            push(@temparray, "\n");
            $i = 0;
        }
    }

    my $out_string = $header . join("\t", @temparray) . "\n";
    print("out_string=>>$out_string<<\n")  if $debug_mode;
    return $out_string;

}

################################################################################
# Normalize is called to convert the text to perl again from the encoded version.
#

sub normalize
{
    my $in_string = shift;;

    $in_string =~ s/^$header//g;

    print("normalize, got in_string>>$in_string<<\n")  if $debug_mode;

    my %revhash = ();
    my $counter = 0;
    foreach my $this_elem (@xlate_array)
    {
        $revhash{$this_elem} = $counter++;
    }

    $in_string =~ s/\t\n/\t/g;
    $in_string =~ s/\t+/\t/g;
    my @in_array  = split(/[\t]/, $in_string);
    my $in_array_dump = Dumper(@in_array);
    print("in_array_dump=>>$in_array_dump<<\n")  if $debug_mode;

    my @translate_array = ();
    my $this_elem = "";
    $counter = 1;
    foreach $this_elem (@in_array)
    {
        if (!($this_elem)) { print("Found undefined elem, counter=$counter.\n"); $counter++; next; }
        my $ascii_num = $xlate_2_hash{$this_elem} || 0;
        my $to_char = pack("c", $ascii_num);
        printf("Normalized >>%s<<, ascii_num=>>%s<<, char=>>%s<<, counter=>>%s<<\n", $this_elem, $ascii_num, $to_char, $counter)  if $debug_mode;
        push(@translate_array, $to_char);
        $counter++;
    }

    my $outtext = join('', @translate_array);
    print("Converted back to text=>>$outtext<<\n") if $debug_mode;

    return("$outtext");

}

###############################################################################

sub has_wordchars
{

    my $in_string = shift;
    my $retval = 0;

    print("In has_wordchars\n") if $debug_mode;

    if ($in_string =~ /\s/)
    {
        return $in_string;
    }
    else
    {
        return 0;
    }
}

###############################################################################

sub starts_with_header
{

    my $in_string = shift;
    my $retval = 0;

    print("In starts_with_header\n") if $debug_mode;

    if ($in_string =~ /^$header/)
    {
        return $in_string;
    }
    else
    {
        return 0;
    }

}

###############################################################################

sub import
{