File Coverage

blib/lib/Barcode/Cuecat.pm

Criterion	Covered	Total	%
statement	6	35	17.1
branch	0	6	0.0
condition	0	2	0.0
subroutine	2	9	22.2
pod	5	5	100.0
total	13	57	22.8

package Barcode::Cuecat;

require 5.005_62;
use strict;
use warnings;

our $VERSION = '1.20';

sub new {
    my $type = shift;
    my $class = ref($type) || $type || "Barcode::Cuecat";
    my $string = shift;

    my $self = bless [], $class;

    $self->scan($string) if defined $string;

    return $self;
}

sub _decode {
    my $input = shift;

    $input =~ tr/a-zA-Z0-9+-/ -_/;

    $input = unpack 'u', chr(32 + length($input)*3/4) . $input;
    $input ^= "C" x length($input);

    return $input;
}

sub _cuecat_decode {
    my $input = shift;
    $input ^= chr(32) x length($input);
    return join '', map {
	$_ = sprintf("%02d", ord($_));
    } split(//, $input);
}

sub scan ($) {
    my $self = shift;
    my $stuff = shift;

    return unless defined $stuff;

    my @items = (split(/\./, $stuff))[1..3];

    $self->[0] = _decode($items[0]);
    $self->[1] = _decode($items[1]);
    $self->[2] = _decode($items[2]);

    if ($self->[1] =~ /^CC(.)/) {
	$self->[1] = ':C1';	# Proprietary :CueCat
	$self->[2] = _cuecat_decode($1 . $self->[2]);
    }

    return $self->[2];
}

sub serial {
    return $_[0]->[0];
}

sub type {
    return $_[0]->[1];
}

sub code {
    return $_[0]->[2];
}

1;
__END__