view release on metacpan or  search on metacpan

lib/ClarID/Tools/Command/qrcode.pm  view on Meta::CPAN

  format  => 's',
  isa     => Str,
  default => sub { 'qrcodes' },
  doc     => 'Where to write PNGs (encode only)',
);

option 'outfile' => (
  is      => 'ro',
  format  => 's',
  isa     => Str,
  default => sub { 'decoded.csv' },
  doc     => 'Where to write CSV (decode directory mode only)',
);

option 'sep' => (
  is      => 'ro',
  format  => 's',
  isa     => Str,
  default => sub { ',' },
  doc     => 'CSV separator',
);

lib/ClarID/Tools/Command/qrcode.pm  view on Meta::CPAN

sub _run_decode {
    my $self = shift;

    # Check for zbarimg
    system("which zbarimg >/dev/null 2>&1") == 0
        or croak "ERROR: 'zbarimg' not found in PATH";

    # Single-file decode mode
    if (-f $self->input && $self->input =~ /\.png$/i) {
        my $file = $self->input;
        chomp(my $decoded = qx(zbarimg --raw "$file" 2>/dev/null));
        die "ERROR: no QR code found in '$file'\n" unless length $decoded;
        say $decoded;
        return 1;
    }

    # Directory decode mode
    my $col_name = $self->column || 'clar_id';
    opendir my $dh, $self->input
        or croak "ERROR: Cannot open directory '$self->input': $!";
    my @files = grep { /\.png$/i } readdir $dh;
    closedir $dh;

    open my $out, '>', $self->outfile
        or croak "ERROR: Cannot write to '$self->outfile': $!";
    print $out "$col_name\n";

    for my $f (@files) {
        my $path = "$self->{input}/$f";
        chomp(my $decoded = qx(zbarimg --raw "$path" 2>/dev/null));
        next unless length $decoded;
        $decoded =~ s/\r?\n//g;
        print $out "$decoded\n";
    }
    close $out;
    say "Decoded CSV written to '$self->{outfile}'";
}

1;

t/qrcode.t  view on Meta::CPAN

    system("$^X $inc $exe qrcode --action=encode --input=$csv --outdir=$work")
      == 0,
    "ran clarid-tools qrcode encode"
);

# 3) Check that the PNG exists and isn’t empty
my $png = catfile( $work, "$value.png" );
ok( -f $png && -s $png, "generated non‑empty file $png" );

# 4) Decode with zbarimg and verify the payload
chomp( my $decoded = `zbarimg --raw "$png" 2>/dev/null` );
is( $decoded, $value, "round‑trip decode yields '$value'" );

# 5) Run the decode with clarid-tools and verify the payload
my $out = catfile( $work, "$value.txt" );
ok( system("$^X $inc $exe qrcode --action=decode --input=$png > $out") == 0,
    "ran clarid-tools qrcode decode" );

$decoded = do {
    open my $fh, '<', $out or die "open: $!";
    local $/ = undef;
    <$fh>;
};
chomp $decoded;
is( $decoded, $value, "clarid-tools decode yields '$value'" );

# 6) Run the decode in directory mode
my $outbis = catfile( $work, "decoded.csv" );
ok(
    system(
        "$^X $inc $exe qrcode --action=decode --input=$work  --outfile=$outbis")
      == 0,
    "ran clarid-tools qrcode decode"
);
$decoded = do {
    open my $fh, '<', $outbis or die "open: $!";
    my $header = <$fh>;    # read & discard header
    local $/ = undef;
    <$fh>;
};
chomp $decoded;
is( $decoded, $value, "clarid-tools decode dir yields '$value'" );

# cleanup
unlink $png;
unlink $csv;
unlink $out;
unlink $outbis;
rmdir $work;

done_testing();