sql/base/02-barcodes.sql

   1 CREATE OR REPLACE FUNCTION migration_tools.rebarcode (o TEXT, t BIGINT) RETURNS TEXT AS $$
   2     DECLARE
   3         n TEXT := o;
   4     BEGIN
   5         IF o ~ E'^\\d+$' AND o !~ E'^0' AND length(o) < 19 THEN -- for reference, the max value for a bigint is 9223372036854775807.  May also want to consider the case where folks want to add prefixes to non-numeric barcodes
   6             IF o::BIGINT < t THEN
   7                 n = o::BIGINT + t;
   8             END IF;
   9         END IF;
  10
  11         RETURN n;
  12     END;
  13 $$ LANGUAGE PLPGSQL STRICT IMMUTABLE;
  14
  15 -- expand_barcode
  16 --   $barcode      source barcode
  17 --   $prefix       prefix to add to barcode, NULL = add no prefix
  18 --   $maxlen       maximum length of barcode; default to 14 if left NULL
  19 --   $pad          padding string to apply to left of source barcode before adding
  20 --                 prefix and suffix; set to NULL or '' if no padding is desired
  21 --   $suffix       suffix to add to barcode, NULL = add no suffix
  22 --
  23 -- Returns a new string consisting of prefix concatenated with padded barcode and suffix.
  24 -- If new barcode would be longer than $maxlen, the original barcode is returned instead.
  25 --
  26 CREATE OR REPLACE FUNCTION migration_tools.expand_barcode (TEXT, TEXT, INTEGER, TEXT, TEXT) RETURNS TEXT AS $$
  27     my ($barcode, $prefix, $maxlen, $pad, $suffix) = @_;
  28
  29     # default case
  30     return unless defined $barcode;
  31
  32     $prefix     = '' unless defined $prefix;
  33     $maxlen ||= 14;
  34     $pad        = '0' unless defined $pad;
  35     $suffix     = '' unless defined $suffix;
  36
  37     # bail out if adding prefix and suffix would bring new barcode over max length
  38     return $barcode if (length($prefix) + length($barcode) + length($suffix)) > $maxlen;
  39
  40     my $new_barcode = $barcode;
  41     if ($pad ne '') {
  42         my $pad_length = $maxlen - length($prefix) - length($suffix);
  43         if (length($barcode) < $pad_length) {
  44             # assuming we always want padding on the left
  45             # also assuming that it is possible to have the pad string be longer than 1 character
  46             $new_barcode = substr($pad x ($pad_length - length($barcode)), 0, $pad_length - length($barcode)) . $new_barcode;
  47         }
  48     }
  49
  50     # bail out if adding prefix and suffix would bring new barcode over max length
  51     return $barcode if (length($prefix) + length($new_barcode) + length($suffix)) > $maxlen;
  52
  53     return "$prefix$new_barcode$suffix";
  54 $$ LANGUAGE PLPERLU STABLE;
  55
  56 -- add_codabar_checkdigit
  57 --   $barcode      source barcode
  58 --
  59 -- If the source string is 13 or 14 characters long and contains only digits, adds or replaces the 14
  60 -- character with a checkdigit computed according to the usual algorithm for library barcodes
  61 -- using the Codabar symbology - see <http://www.makebarcode.com/specs/codabar.html>.  If the
  62 -- input string does not meet those requirements, it is returned unchanged.
  63 --
  64 CREATE OR REPLACE FUNCTION migration_tools.add_codabar_checkdigit (TEXT) RETURNS TEXT AS $$
  65     my $barcode = shift;
  66
  67     return $barcode if $barcode !~ /^\d{13,14}$/;
  68     $barcode = substr($barcode, 0, 13); # ignore 14th digit
  69     my @digits = split //, $barcode;
  70     my $total = 0;
  71     $total += $digits[$_] foreach (1, 3, 5, 7, 9, 11);
  72     $total += (2 * $digits[$_] >= 10) ? (2 * $digits[$_] - 9) : (2 * $digits[$_]) foreach (0, 2, 4, 6, 8, 10, 12);
  73     my $remainder = $total % 10;
  74     my $checkdigit = ($remainder == 0) ? $remainder : 10 - $remainder;
  75     return $barcode . $checkdigit;
  76 $$ LANGUAGE PLPERLU STRICT STABLE;
  77
  78 -- add_code39mod43_checkdigit
  79 --   $barcode      source barcode
  80 --
  81 -- If the source string is 13 or 14 characters long and contains only valid
  82 -- Code 39 mod 43 characters, adds or replaces the 14th
  83 -- character with a checkdigit computed according to the usual algorithm for library barcodes
  84 -- using the Code 39 mod 43 symbology - see <http://en.wikipedia.org/wiki/Code_39#Code_39_mod_43>.  If the
  85 -- input string does not meet those requirements, it is returned unchanged.
  86 --
  87 CREATE OR REPLACE FUNCTION migration_tools.add_code39mod43_checkdigit (TEXT) RETURNS TEXT AS $$
  88     my $barcode = shift;
  89
  90     return $barcode if $barcode !~ /^[0-9A-Z. $\/+%-]{13,14}$/;
  91     $barcode = substr($barcode, 0, 13); # ignore 14th character
  92
  93     my @valid_chars = split //, '0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ-. $/+%';
  94     my %nums = map { $valid_chars[$_] => $_ } (0..42);
  95
  96     my $total = 0;
  97     $total += $nums{$_} foreach split(//, $barcode);
  98     my $remainder = $total % 43;
  99     my $checkdigit = $valid_chars[$remainder];
 100     return $barcode . $checkdigit;
 101 $$ LANGUAGE PLPERLU STRICT STABLE;
 102
 103 -- add_mod16_checkdigit
 104 --   $barcode      source barcode
 105 --
 106 -- https://www.activebarcode.com/codes/checkdigit/modulo16.html
 107
 108 CREATE OR REPLACE FUNCTION migration_tools.add_mod16_checkdigit (TEXT) RETURNS TEXT AS $$
 109     my $barcode = shift;
 110
 111     my @digits = split //, $barcode;
 112     my $total = 0;
 113     foreach $digit (@digits) {
 114         if ($digit =~ /[0-9]/) { $total += $digit;
 115         } elsif ($digit eq '-') { $total += 10;
 116         } elsif ($digit eq '$') { $total += 11;
 117         } elsif ($digit eq ':') { $total += 12;
 118         } elsif ($digit eq '/') { $total += 13;
 119         } elsif ($digit eq '.') { $total += 14;
 120         } elsif ($digit eq '+') { $total += 15;
 121         } elsif ($digit eq 'A') { $total += 16;
 122         } elsif ($digit eq 'B') { $total += 17;
 123         } elsif ($digit eq 'C') { $total += 18;
 124         } elsif ($digit eq 'D') { $total += 19;
 125         } else { die "invalid digit <$digit>";
 126         }
 127     }
 128     my $remainder = $total % 16;
 129     my $difference = 16 - $remainder;
 130     my $checkdigit;
 131     if ($difference < 10) { $checkdigit = $difference;
 132     } elsif ($difference == 10) { $checkdigit = '-';
 133     } elsif ($difference == 11) { $checkdigit = '$';
 134     } elsif ($difference == 12) { $checkdigit = ':';
 135     } elsif ($difference == 13) { $checkdigit = '/';
 136     } elsif ($difference == 14) { $checkdigit = '.';
 137     } elsif ($difference == 15) { $checkdigit = '+';
 138     } else { die "error calculating checkdigit";
 139     }
 140
 141     return $barcode . $checkdigit;
 142 $$ LANGUAGE PLPERLU STRICT STABLE;
 143