QRCode-Encoder

 view release on metacpan or  search on metacpan

t/01-hello.t  view on Meta::CPAN

#!/usr/bin/env perl
use strict;
use warnings;

#use Test::More tests => 1; # last test to print
use Test::More 'no_plan';  # substitute with previous line when done
use QRCode::Encoder qw< qr_encode >;

my $message = 'HELLO WORLD';

my $encoded = qr_encode($message, level => 'M');
is $encoded->{version}, 1, 'version';
is_deeply($encoded->{matrix}, expected_matrix(), 'matrix');
is_deeply($encoded->{plot}, expected_plot(), 'plot');

done_testing();

sub expected_plot {
   my $string = <<'END';
. 
. 
. 
. 
.    *******   * * *******
.    *     * ***   *     *
.    * *** *   * * * *** *
.    * *** *   * * * *** *
.    * *** * * *** * *** *
.    *     *  ***  *     *
.    ******* * * * *******
. 
.    * * * *  *  *   *  *
.     ****   *  *    *   *
.       ******* *  * **
.    **** * **  *** * ***
.     *  **** * *  *** * *
.            * *   *   * *
.    *******     *  * **
.    *     *  **   ** *
.    * *** * **  * *******
.    * *** *   ** * *   *
.    * *** * **** *** *  *
.    *     *    ***   * **
.    ******* ** * ***    *
. 
. 
. 
. 
END
   my $w = 4 + 21 + 4;
   my @retval = map {
      my @row = split m{}mxs, $_;
      shift(@row);
      push @row, ' ' while @row < $w;
      \@row;
   } split m{\n}mxs, $string;
   return \@retval;
}

sub expected_matrix {
   return [
      [
         48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
         48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48 ],
      [
         48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
         48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48
      ],
      [
         48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
         48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48
      ],
      [
         48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48,
         48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48
      ],
      [
         48, 48, 48, 48, 49, 49, 49, 49, 49, 49, 49, 48, 48, 54, 55,
         54, 55, 48, 49, 49, 49, 49, 49, 49, 49, 48, 48, 48, 48
      ],
      [
         48, 48, 48, 48, 49, 48, 48, 48, 48, 48, 49, 48, 49, 55, 55,
         54, 54, 48, 49, 48, 48, 48, 48, 48, 49, 48, 48, 48, 48
      ],
      [
         48, 48, 48, 48, 49, 48, 49, 49, 49, 48, 49, 48, 48, 54, 55,
         54, 55, 48, 49, 48, 49, 49, 49, 48, 49, 48, 48, 48, 48
      ],
      [
         48, 48, 48, 48, 49, 48, 49, 49, 49, 48, 49, 48, 48, 54, 55,
         54, 55, 48, 49, 48, 49, 49, 49, 48, 49, 48, 48, 48, 48
      ],
      [
         48, 48, 48, 48, 49, 48, 49, 49, 49, 48, 49, 48, 49, 54, 55,
         55, 55, 48, 49, 48, 49, 49, 49, 48, 49, 48, 48, 48, 48
      ],
      [
         48, 48, 48, 48, 49, 48, 48, 48, 48, 48, 49, 48, 48, 55, 55,
         55, 54, 48, 49, 48, 48, 48, 48, 48, 49, 48, 48, 48, 48
      ],
      [
         48, 48, 48, 48, 49, 49, 49, 49, 49, 49, 49, 48, 53, 52, 53,
         52, 53, 48, 49, 49, 49, 49, 49, 49, 49, 48, 48, 48, 48
      ],
      [
         48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 54, 54,
         54, 54, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48, 48
      ],
      [
         48, 48, 48, 48, 49, 48, 49, 48, 49, 48, 53, 48, 48, 55, 54,
         54, 55, 48, 48, 48, 49, 48, 48, 49, 48, 48, 48, 48, 48
      ],
      [
         48, 48, 48, 48, 54, 55, 55, 55, 55, 54, 52, 54, 55, 54, 54,
         55, 54, 54, 54, 54, 55, 54, 54, 54, 55, 48, 48, 48, 48
      ],



( run in 0.503 second using v1.01-cache-2.11-cpan-71847e10f99 )