view release on metacpan or  search on metacpan

lib/Data/URIID/Barcode.pm  view on Meta::CPAN

use v5.16;
use strict;
use warnings;

use Carp;
use Scalar::Util qw(weaken);

our $VERSION = v0.20;

use parent 'Data::URIID::Base';

use constant {map {$_ => []} qw(TYPE_UNKNOWN TYPE_OTHER TYPE_QRCODE TYPE_EAN13 TYPE_EAN8)};

my %_type_info = (
    TYPE_UNKNOWN()  => {
        type    => TYPE_UNKNOWN,
        special => 1,
    },
    TYPE_OTHER()    => {
        type    => TYPE_OTHER,
        special => 1,
    },
    TYPE_QRCODE()   => {
        type    => TYPE_QRCODE,
        aliases => [qw(qrcode qr-code)],
    },
    TYPE_EAN13()    => {
        type    => TYPE_EAN13,
        aliases => [qw(ean13 ean-13)],
    },
    TYPE_EAN8()     => {
        type    => TYPE_EAN8,
        aliases => [qw(ean8 ean-8)],
    },
);



sub sheet {
    my ($pkg, %opts) = @_;
    my $from        = delete $opts{from};
    my $filename    = delete $opts{filename};
    my $template    = delete $opts{template};
    my $values      = delete $opts{values};
    my $filter_type = delete $opts{filter_type};
    my $filter_data = delete $opts{filter_data};
    my %pass_opts;
    my @res;
    my $done;

    foreach my $key (qw(extractor type)) {
        $pass_opts{$key} = delete $opts{$key} // next;;
    }

    if (!defined($from) && defined($values)) {
        @res = map {{barcode => $_, quality => 0.001}}
               map {$pkg->new(%pass_opts, ref($_) ? (from => $_) : (data => sprintf($template // '%s', $_)))}
               @{$values};
               $done = 1;
    } elsif (!defined($from) && defined($filename)) {
        require Image::Magick;
        $from = Image::Magick->new();
        $from->Read($filename) && croak 'Cannot read file';
    }

    croak 'Stray options passed' if scalar keys %opts;

    unless ($done) {
        croak 'No from given' unless defined $from;

        if ($from->isa('Image::Magick')) {
            require Barcode::ZBar;

            my $raw = $from->ImageToBlob(magick => 'GRAY', depth => 8);
            my ($col, $rows) = $from->Get(qw(columns rows));
            my $scanner = Barcode::ZBar::ImageScanner->new();

            $from = Barcode::ZBar::Image->new();
            $from->set_format('Y800');
            $from->set_size($col, $rows);
            $from->set_data($raw);

            $scanner->parse_config("enable");

            $scanner->scan_image($from);
        }

        if ($from->isa('Barcode::ZBar::Image')) {
            my $max_quality;

            foreach my $symbol ($from->get_symbols()) {
                my $raw_type = $symbol->get_type;
                my $raw_data = $symbol->get_data;
                my $raw_quality = $symbol->get_quality;
                my $type;

                if ($raw_type eq $symbol->QRCODE) {
                    $type = TYPE_QRCODE;
                } elsif ($raw_type eq $symbol->EAN13) {
                    $type = TYPE_EAN13;
                } elsif ($raw_type eq $symbol->EAN8) {
                    $type = TYPE_EAN8;
                }

                $type //= TYPE_OTHER;

                $max_quality = $raw_quality if !defined($max_quality) || $max_quality < $raw_quality;
                push(@res, {
                        barcode => $pkg->new(%pass_opts, type => $type, data => $raw_data),
                        _raw_ => $symbol,
                    });
            }

            foreach my $res (@res) {
                my $symbol = delete $res->{_raw_};
                $res->{quality} = $symbol->get_quality / $max_quality;
            }
        } else {
            croak 'From of invalid/unsupported type';
        }
    }

    if (defined $filter_type) {
        @res = grep {$_->{barcode}->has_type($filter_type)} @res;
    }

    if (defined $filter_data) {
        if (ref($filter_data) eq 'CODE') {
            @res = grep {$filter_data->($_->{barcode}->{data})} @res;
        } else {
            @res = grep {$_->{barcode}->{data} =~ $filter_data} @res;