openepaperlink plugin: initial commit

contrib/oepl_resources/LICENSE-TerminusTTF

@@ -0,0 +1,97 @@
+Copyright (c) 2010 Dimitar Toshkov Zhekov,
+with Reserved Font Name "Terminus Font".
+
+Copyright (c) 2011-2023 Tilman Blumenbach,
+with Reserved Font Name "Terminus (TTF)".
+
+This Font Software is licensed under the SIL Open Font License, Version 1.1.
+This license is copied below, and is also available with a FAQ at:
+http://scripts.sil.org/OFL
+
+
+-----------------------------------------------------------
+SIL OPEN FONT LICENSE Version 1.1 - 26 February 2007
+-----------------------------------------------------------
+
+PREAMBLE
+The goals of the Open Font License (OFL) are to stimulate worldwide
+development of collaborative font projects, to support the font creation
+efforts of academic and linguistic communities, and to provide a free and
+open framework in which fonts may be shared and improved in partnership
+with others.
+
+The OFL allows the licensed fonts to be used, studied, modified and
+redistributed freely as long as they are not sold by themselves. The
+fonts, including any derivative works, can be bundled, embedded, 
+redistributed and/or sold with any software provided that any reserved
+names are not used by derivative works. The fonts and derivatives,
+however, cannot be released under any other type of license. The
+requirement for fonts to remain under this license does not apply
+to any document created using the fonts or their derivatives.
+
+DEFINITIONS
+"Font Software" refers to the set of files released by the Copyright
+Holder(s) under this license and clearly marked as such. This may
+include source files, build scripts and documentation.
+
+"Reserved Font Name" refers to any names specified as such after the
+copyright statement(s).
+
+"Original Version" refers to the collection of Font Software components as
+distributed by the Copyright Holder(s).
+
+"Modified Version" refers to any derivative made by adding to, deleting,
+or substituting -- in part or in whole -- any of the components of the
+Original Version, by changing formats or by porting the Font Software to a
+new environment.
+
+"Author" refers to any designer, engineer, programmer, technical
+writer or other person who contributed to the Font Software.
+
+PERMISSION & CONDITIONS
+Permission is hereby granted, free of charge, to any person obtaining
+a copy of the Font Software, to use, study, copy, merge, embed, modify,
+redistribute, and sell modified and unmodified copies of the Font
+Software, subject to the following conditions:
+
+1) Neither the Font Software nor any of its individual components,
+in Original or Modified Versions, may be sold by itself.
+
+2) Original or Modified Versions of the Font Software may be bundled,
+redistributed and/or sold with any software, provided that each copy
+contains the above copyright notice and this license. These can be
+included either as stand-alone text files, human-readable headers or
+in the appropriate machine-readable metadata fields within text or
+binary files as long as those fields can be easily viewed by the user.
+
+3) No Modified Version of the Font Software may use the Reserved Font
+Name(s) unless explicit written permission is granted by the corresponding
+Copyright Holder. This restriction only applies to the primary font name as
+presented to the users.
+
+4) The name(s) of the Copyright Holder(s) or the Author(s) of the Font
+Software shall not be used to promote, endorse or advertise any
+Modified Version, except to acknowledge the contribution(s) of the
+Copyright Holder(s) and the Author(s) or with their explicit written
+permission.
+
+5) The Font Software, modified or unmodified, in part or in whole,
+must be distributed entirely under this license, and must not be
+distributed under any other license. The requirement for fonts to
+remain under this license does not apply to any document created
+using the Font Software.
+
+TERMINATION
+This license becomes null and void if any of the above conditions are
+not met.
+
+DISCLAIMER
+THE FONT SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO ANY WARRANTIES OF
+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT
+OF COPYRIGHT, PATENT, TRADEMARK, OR OTHER RIGHT. IN NO EVENT SHALL THE
+COPYRIGHT HOLDER BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
+INCLUDING ANY GENERAL, SPECIAL, INDIRECT, INCIDENTAL, OR CONSEQUENTIAL
+DAMAGES, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
+FROM, OUT OF THE USE OR INABILITY TO USE THE FONT SOFTWARE OR FROM
+OTHER DEALINGS IN THE FONT SOFTWARE.

contrib/openepaperlink.pl

@@ -0,0 +1,255 @@
+#!/usr/bin/perl
+use v5.36;
+use autodie;
+
+use FindBin;
+use lib "$FindBin::Bin/../lib";
+use RevBank::Products;
+
+use Imager;
+use Imager::Fill;
+use Imager::Font::Wrap;
+use LWP::Simple qw($ua);
+use JSON::XS ();
+
+my $json = JSON::XS->new;
+
+my $resources = "$FindBin::Bin/oepl_resources";
+my $outdir = "./oepl_images";
+my $ap = 'http://10.42.42.123';
+
+eval { mkdir $outdir };
+
+sub slurp ($fn) { local (@ARGV) = $fn; local $/ = wantarray ? "\n" : undef; <> }
+sub spurt ($fn, @data) { open my $fh, '>', $fn; print $fh @data; }
+
+sub post ($uri, $kv) {
+	for (my $i = 0; $i < @$kv; $i += 2) {
+		if ($kv->[$i] eq "file") {
+			$kv->[$i + 1] = [ $kv->[$i + 1], "filename.jpg", Content_Type => "image/jpeg" ];
+			last;
+		}
+	}
+
+	my $response = $ua->post("$ap/$uri", Content_Type => 'form-data', Content => $kv);
+	warn $response->content if not $response->is_success;
+	return $response->is_success;
+}
+
+
+sub draw ($product, $hwtype, $force) {
+	my $sub = main->can("draw_hwtype_$hwtype") or do {
+		warn "Unsupported hwtype ($hwtype)";
+		return undef;
+	};
+	$product->{_fn} = $product->{id} =~ s/([^A-Za-z0-9_])/sprintf("%%%02x", ord $1)/ger;
+	my $image = $sub->($product);
+
+	my $fn = "$outdir/$product->{_fn}\_$hwtype.jpg";
+	my $old = -e $fn ? slurp($fn) : "";
+
+	$image->write(
+		data => \my $new,
+		type => "jpeg",
+		jpegquality => 100,  # no underscore
+		jpeg_optimize => 1,
+		jpeg_sample => "1x1",  # 1x1 = 4:4:4
+	) or die $image->errstr;
+
+	if ($force or $new ne $old) {
+		spurt $fn, $new if $new ne $old;
+		return $fn;
+	}
+
+	return undef;
+}
+
+sub get_hwtype($mac) {
+	my $response = $ua->get("$ap/get_db?mac=$mac");
+	my $hash = eval { $json->decode($response->content) } || { tags => [] };
+	my $tags = $hash->{tags};
+	if (@$tags != 1) {
+		my $status = $response->status_line;
+		warn "Can't get hwtype for $mac (HTTP $status); new tag not ready yet?\n";
+		return undef;
+	}
+	return $tags->[0]->{hwType};
+}
+
+sub comma($str) {
+	"$str" =~ s/\./,/gr =~ s/0/O/gr;
+}
+
+sub aztec($product) {
+	my $fn = "$outdir/$product->{_fn}_aztec.png";
+
+	if (not -e $fn) {
+		system qw(zint --barcode 92 --vers 3 --scale 1 --filetype PNG --nobackground --whitesp 0 --vwhitesp 0), "--data" => $product->{id}, "--output" => $fn;
+	}
+
+	return Imager->new->read(file => $fn) if -e $fn;
+}
+
+sub draw_hwtype_3 ($product) {
+	my $xsize = 212;
+	my $ysize = 104;
+
+	# 18px \
+	# 18px |  54 px
+	# 18px /
+	# 1px  \
+	# 48px |  50 px
+	# 1px  /
+
+
+	my @colors = (
+		my $white = Imager::Color->new(255,255,255),
+		my $black = Imager::Color->new(0,0,0),
+		my $red   = Imager::Color->new(255,0,0),
+	);
+
+	my $font = Imager::Font->new(file => "$resources/TerminusTTF-Bold-4.49.3.ttf", aa => 0);
+
+	# Terminus sizes: 12 14 16 18 20 22 24 28 32
+
+	my $image = Imager->new(xsize => $xsize, ysize => $ysize);
+	$image->setcolors(colors => \@colors);
+	$image->box(filled => 1, color => $product->{tags}{promo} ? $red : $white);
+
+	my $h = $font->bounding_box(string => "")->font_height + 1;
+
+	my $addon_text;
+	my $addon_highlight = 0;
+
+	for my $addon (@{ $product->{addons} }) {
+		next if $addon->{tags}{OPAQUE};
+		my $d = $addon->{description};
+		$addon_text = ($addon->{price} < 0) ? $d : "+ $d";
+		$addon_highlight = 1 if $addon->{price} < 0;
+		last;
+	}
+
+	my $text = $product->{description};
+
+	my (undef, undef, undef, $bottom) = Imager::Font::Wrap->wrap_text(
+		image => $image,
+		font => $font,
+		string => $text,
+		color => $black,
+		justify => "center",
+		x => 0,
+		y => 0,
+		size => 18,
+		height => ($addon_text ? 36 : 54),
+	);
+	#warn $bottom;
+	#die if $product->{id} eq '5000112659863';
+
+	$addon_text and Imager::Font::Wrap->wrap_text(
+		image => $image,
+		font => $font,
+		string => $addon_text,
+		color => ($addon_highlight ? $red : $black),
+		justify => "center",
+		x => 0,
+		y => $bottom,
+		size => 18,
+		height => 54 - $bottom,
+	);
+
+	my $xmargin = 6;
+	my $ymargin = 2;
+	my $has_discount = $product->{tag_price} < $product->{price};
+
+	my $price = sub {
+		return $image->align_string(
+			x => $xsize - 1 - $xmargin,
+			y => $ysize - 1 - $ymargin,
+			valign => 'bottom',
+			halign => 'right',
+			string => comma($product->{tag_price}),
+			utf8 => 1,
+			color => ($has_discount ? $white : $white),
+			font => $font,
+			aa => 0,
+			size => 32,
+		);
+	};
+
+	my @bounds = $price->();
+
+
+	my @box = ($bounds[0] - $xmargin, $bounds[1] - $ymargin, $bounds[2] + $xmargin, $bounds[3] + $ymargin);
+	$image->box(box => \@box, fill => { solid => ($has_discount ? $red : $black) });
+	$price->();
+
+	if (my $unit = $product->{tags}{ml} ? "ml" : $product->{tags}{g} ? "g" : undef) {
+		my $X = $unit eq "ml" ? "L" : $unit eq "g" ? "kg" : die;
+		my $perX = sprintf "%.02f", $product->{tag_price}->float * 1000 / $product->{tags}{$unit};
+
+		@bounds = $image->align_string(
+			x => $box[2],
+			y => $box[1],
+			valign => 'bottom',
+			halign => 'right',
+			string => comma("$product->{tags}{$unit} $unit $perX/$X"),
+			utf8 => 1,
+			color => $black,
+			font => $font,
+			aa => 0,
+			size => 12,
+		);
+	}
+
+	# There's place for only 1 but looping over all is easier :)
+	# Intended purpose is statiegeld logos.
+	for my $addon (@{ $product->{addons} }) {
+		my $fn = "$resources/$addon->{id}.png";
+		-e $fn or next;
+		my $statiegeld = Imager->new->read(file => $fn);
+		$image->compose(src => $statiegeld, tx => 63, ty => $ysize - 48 - 1);
+	}
+
+	if (my $aztec = aztec $product) {
+		$image->compose(src => $aztec, tx => 1, ty => $ysize - 46 - 1);
+	}
+
+	return $image;
+}
+
+my @lines = slurp "revbank.oepl";
+my %new_hwtype;
+
+my $products = read_products;
+$products->{_DELETED_} = {
+	id => "_DELETED_",
+	description => "(deleted)",
+	price => "999.99",
+	tag_price => "999.99",
+};
+
+for my $line (@lines) {
+	my ($mac, $product_id, $hwtype) = split " ", $line;
+	$mac and $mac =~ /^[0-F]{12,16}$/ or next;
+	$product_id or next;
+	(grep { $_ eq $product_id or $_ eq $mac } @ARGV) or next if @ARGV;
+
+	my $product = $products->{$product_id} or do {
+		warn "Product not found ($product_id)\n";
+		next;
+	};
+
+	$hwtype ||= $new_hwtype{$mac} = get_hwtype($mac) || next;
+	my $fn = draw($product, $hwtype, !!@ARGV) or next;
+
+	print "Uploading image for $mac ($product->{description}).\n";
+	post "imgupload" => [ mac => $mac, file => $fn, lut => 1, alias => $product->{description} ];
+
+	if ($new_hwtype{$mac}) {
+		$line =~ s/$/ $new_hwtype{$mac}/;
+	}
+}
+
+if (%new_hwtype) {
+	spurt "revbank.oepl", @lines;
+}

plugins/openepaperlink

@@ -0,0 +1,76 @@
+#!perl
+use RevBank::Products qw(read_products);
+use FindBin qw($Bin);
+
+my $fn = "revbank.oepl";
+my $hex = '[0-9A-F]';
+my $mac_regex = qr/^(?:$hex {12}|$hex {14}|$hex {16})$/x;
+
+sub _create() {
+	open my $fh, '>>', $fn;
+}
+
+sub _run(@args) {
+	system perl => "$Bin/contrib/openepaperlink.pl", @args;
+}
+
+sub command :Tab(openepaperlink) ($self, $cart, $command, @) {
+	if ($command =~ $mac_regex) {
+		my %mac2product = map { (split " ")[0, 1] } slurp $fn;
+		return REDO, $mac2product{$command} if exists $mac2product{$command};
+	}
+
+	$command eq 'openepaperlink' or return NEXT;
+
+	return "Product ID (or 'unlink')", sub ($self, $cart, $product_id, @) {
+		my $product;
+
+		if ($product_id ne 'unlink') {
+			$product = read_products->{$product_id} or return REJECT, "No such product.";
+			$product_id = $product->{id};  # don't use alias
+		}
+
+		return "Tag MAC", sub ($self, $cart, $mac, @) {
+			$mac =~ $mac_regex or return REJECT, "Malformed MAC.";
+
+			_create;
+			my $found = 0;
+			rewrite $fn, sub($line) {
+				my ($m) = split " ", $line;
+				return $line if $m ne $mac;
+				$found++;
+				return undef if $product_id eq 'unlink';
+				return "$mac $product_id\n" if $m eq $mac;
+			};
+			if (!$found and $product_id ne 'unlink') {
+				append $fn, "$mac $product_id\n";
+			}
+			_run($mac);
+
+			return ACCEPT;
+		};
+	};
+}
+
+sub hook_product_deleted($class, $product, $mtime, @) {
+	my $product_id = $product->{id};
+
+	-f $fn or return;
+	my @macs;
+
+	rewrite $fn, sub($line) {
+		my ($mac, $id, $hwtype) = split " ", $line;
+
+		if ($id eq $product_id) {
+			push @macs, $mac;
+			return "$mac _DELETED_ $hwtype\n" 
+		}
+
+		return $line;
+	};
+	_run(@macs);
+}
+
+sub hook_product_changed($class, $old, $new, $mtime, @) {
+	_run($new->{id});
+}