Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change
 
PerlMonks  

CueCat Decoding Sub

by #include (Curate)
on Feb 10, 2004 at 06:05 UTC ( #327824=snippet: print w/replies, xml ) Need Help??
Description: A small sub to decode the output from a :Cue:Cat barcode scanner.
# ============
# CueCatDecode
# ============
#
# Arguments: 1 - output from CueCat scanner
#
# Returns: An array, structured like this:
#          $array[0] = CueCat ID
#          $array[1] = Type of barcode
#          $array[2] = Barcode data
#
# Example:
#
# my $data=<STDIN>;
# my @barcode=CueCatDecode($data);
# print "ID: $barcode[0]\n";
# print "TYPE: $barcode[1]\n";
# print "BARCODE: $barcode[2]\n";
#
sub CueCatDecode
{
    my($cuecat_output)=@_;

    my $len;
    my $i;
    my $c;

    # Lets Split our CuCat String into a Array with all the differnt s
+ubsections
    my @scanned_data=split /\./,$cuecat_output;

    # Swap upper case to lower case and vice versa, minuses to slashes
    my $id = $scanned_data[1];
    $id =~ tr|A-Za-z\-|a-zA-Z/|;
    $id =~ tr|A-Za-z0-9+/| -_|;       # convert to uuencode format
    $len = chr(32+length($id)*3/4);  # compute length byte
    $id = unpack("u", $len . $id);    # uudecode

    my $barcode_type = $scanned_data[2];
    $barcode_type =~ tr|A-Za-z\-|a-zA-Z/|;
    $barcode_type =~ tr|A-Za-z0-9+/| -_|;       # convert to uuencode 
+format
    $len = chr(32+length($barcode_type)*3/4);  # compute length byte
    $barcode_type = unpack("u", $len . $barcode_type);    # uudecode

    my $barcode = $scanned_data[3];
    $barcode =~ tr|A-Za-z\-|a-zA-Z/|;
    $barcode =~ tr|A-Za-z0-9+/| -_|;       # convert to uuencode forma
+t
    $len = chr(32+length($barcode)*3/4);  # compute length byte
    $barcode = unpack("u", $len . $barcode);    # uudecode


    # Take each character XOR 67
    my $decrypt_id='';
    for ($i=0;$i<length($id);$i++)
    {
        $c = substr($id,$i,1);
        $decrypt_id = $decrypt_id . chr(ord($c) ^ 67);
    }

    my $decrypt_type='';
    for ($i=0;$i<length($barcode_type);$i++)
    {
        $c = substr($barcode_type,$i,1);
        $decrypt_type = $decrypt_type . chr(ord($c) ^ 67);
    }

    my $decrypt_barcode='';
    for ($i=0;$i<length($barcode);$i++)
    {
        $c = substr($barcode,$i,1);
        $decrypt_barcode = $decrypt_barcode . chr(ord($c) ^ 67);
    }

    my @decrypted_barcode=();
    push(@decrypted_barcode,$decrypt_id);
    push(@decrypted_barcode,$decrypt_type);
    push(@decrypted_barcode,$decrypt_barcode);

    return @decrypted_barcode;

}
Replies are listed 'Best First'.
Re: CueCat Decoding Sub
by Mr. Muskrat (Canon) on Feb 10, 2004 at 13:42 UTC

    You might also be interested in looking at The Larry's .sig CueCat decoder:

    #!/usr/bin/perl -n printf "Serial: %s Type: %s Code: %s\n", map { tr/a-zA-Z0-9+-/ -_/; $_ + = unpack 'u', chr(32 + length()*3/4) . $_; s/\0+$//; $_ ^= "C" x length; } /\.( +[^.]+)/g;
    and the Barcode::CueCat module on CPAN as well.

Re: CueCat Decoding Sub
by DrHyde (Prior) on Feb 10, 2004 at 08:52 UTC
    This is waaaaay off-topic but I'll post it anyway :-) There's plenty of online documents explaining how to "declaw" a Cuecat so that there's no need to decode.
Log In?
Username:
Password:

What's my password?
Create A New User
Node Status?
node history
Node Type: snippet [id://327824]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this? | Other CB clients
Other Users?
Others examining the Monastery: (5)
As of 2021-04-20 22:45 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found

    Notices?