From: b <rowerynaksiezycu@gmail.com>
Date: Wed, 27 Sep 2023 22:27:22 +0000 (+0200)
Subject: tool seems ready
X-Git-Url: http://bicyclesonthemoon.info/git-projects/?a=commitdiff_plain;h=06c0cd9151de00d3ba8c887af93ce7601ac226b9;p=cresnov%2Fimagimoth-tracker

tool seems ready
---

diff --git a/moth.pl b/moth.pl
new file mode 100755
index 0000000..705ed8a
--- /dev/null
+++ b/moth.pl
@@ -0,0 +1,333 @@
+#!/usr/bin/perl
+
+# THIS MAKES SOME ASSUMPTION ABOUT PATHS & STUFF
+# YOU MIGHT WANT TO ADJUST THE CONSTANTS
+
+use strict;
+use utf8;
+use Encode::Locale ('decode_argv');
+use Encode ('encode', 'decode');
+use File::Copy;
+
+use lib './botm-common/';
+use botm_common (
+	'merge_url',
+	'system_encoded'
+);
+
+use constant GIT     => 'git';
+use constant WGET    => 'wget';
+use constant ZBARIMG => 'zbarimg'; 
+use constant CONVERT => 'convert';
+use constant CROP    => '56x57+194+81';
+use constant ATTACHMENT_URL_BASE => 'https://cresnov.com/attachments/';
+use constant TREE_PATH      => '/home/b/cresnov/imagimoth/tree/';
+use constant TREE_MOTH_PATH => '/home/b/cresnov/imagimoth/tree/moth.png';
+use constant TREE_GENE_PATH => '/home/b/cresnov/imagimoth/tree/gene.txt';
+use constant TREE_QR_PATH   => '/home/b/cresnov/imagimoth/tree/qr.png';
+use constant TMP_PATH       => '/home/b/cresnov/imagimoth/tmp/';
+use constant TMP_MOTH_PATH  => '/home/b/cresnov/imagimoth/tmp/moth.png';
+use constant TMP_GENE_PATH  => '/home/b/cresnov/imagimoth/tmp/gene.txt';
+use constant TMP_QR_PATH    => '/home/b/cresnov/imagimoth/tmp/qr.png';
+
+binmode STDIN,  ':encoding(UTF-8)';
+binmode STDOUT, ':encoding(UTF-8)';
+binmode STDERR, ':encoding(UTF-8)';
+decode_argv();
+
+$ENV{'GIT_EDITOR'}='true';
+
+if ((scalar @ARGV) < 1) {
+	print STDERR "No action defined.\n";
+	exit 1;
+}
+my $action = $ARGV[0];
+
+if ($action eq 'get') {
+	if ((scalar @ARGV) < 2) {
+		print STDERR "ID missing.\n";
+		exit 1;
+	}
+	my $id = $ARGV[1];
+	download_moth($id);
+	decode_gene();
+}
+elsif ($action eq 'new') {
+	if ((scalar @ARGV) < 2) {
+		print STDERR "ID missing.\n";
+		exit 1;
+	}
+	my $id = $ARGV[1];
+	my $name = $ARGV[2];
+	my $text = $ARGV[3];
+	if ($name eq '') {
+		$name = $id;
+	}
+	download_moth($id);
+	decode_gene();
+	goto_tree();
+	new_branch($name);
+	add_moth();
+	commit($text);
+}
+elsif ($action eq 'rename') {
+	if ((scalar @ARGV) < 3) {
+		print STDERR "Name(s) missing.\n";
+		exit 1;
+	}
+	my $old_name = $ARGV[1];
+	my $new_name = $ARGV[2];
+	goto_tree();
+	goto_branch($old_name);
+	add_branch($new_name);
+	goto_branch($new_name);
+	remove_branch($old_name);
+}
+elsif ($action eq 'addname') {
+	if ((scalar @ARGV) < 3) {
+		print STDERR "Name(s) missing.\n";
+		exit 1;
+	}
+	my $old_name = $ARGV[1];
+	my $new_name = $ARGV[2];
+	goto_tree();
+	goto_branch($old_name);
+	add_branch($new_name);
+	goto_branch($new_name);
+}
+elsif ($action eq 'goto') {
+	if ((scalar @ARGV) < 2) {
+		print STDERR "Name missing.\n";
+		exit 1;
+	}
+	my $name = $ARGV[1];
+	goto_tree();
+	goto_branch($name);
+}
+elsif ($action eq 'rm') {
+	if ((scalar @ARGV) < 2) {
+		print STDERR "Name missing.\n";
+		exit 1;
+	}
+	my $name = $ARGV[1];
+	goto_tree();
+	remove_branch($name);
+}
+elsif ($action eq 'x') {
+	if ((scalar @ARGV) < 5) {
+		print STDERR "Name missing.\n";
+		exit 1;
+	}
+	my $parent_a = $ARGV[1];
+	my $parent_b = $ARGV[2];
+	my $id_0     = $ARGV[3];
+	my $id_1     = $ARGV[4];
+	my $text_0   = $ARGV[5];
+	my $text_1   = $ARGV[6];
+	goto_tree();
+	
+	download_moth($id_0);
+	decode_gene();
+	goto_branch($parent_a);
+	add_branch($id_0);
+	goto_branch($id_0);
+	merge_start($parent_b, $text_0);
+	add_moth();
+	merge_finish($text_0);
+	
+	download_moth($id_1);
+	decode_gene();
+	goto_branch($parent_a);
+	add_branch($id_1);
+	goto_branch($id_1);
+	merge_start($parent_b, $text_1);
+	add_moth();
+	merge_finish($text_1);
+	
+	goto_branch($parent_a);
+}
+
+else {
+	print STDERR "Invalid action: $action.\n";
+	exit 1;
+}
+
+
+sub download_moth {
+	(my $id) = @_;
+	
+	my $r =  system_encoded(WGET(), (
+		WGET(),
+		merge_url(ATTACHMENT_URL_BASE(), $id),
+		'-O', TMP_MOTH_PATH(),
+		'--no-check-certificate'
+	));
+	if ($r != 0) {
+		print STDERR "Moth download fail.\n";
+		exit 1;
+	}
+}
+
+sub decode_gene {
+	my $stdout;
+	my $r;
+	unless (open ($stdout, '>&', STDOUT)) {
+		print STDERR "stdout redirect fail.\n";
+		exit 1;
+	}
+	unless (open (STDOUT, '>:encoding(UTF-8)', encode('locale_fs', TMP_GENE_PATH()))) {
+		print STDERR "Gene file open fail.\n";
+		exit 1;
+	}
+	$r = system_encoded(CONVERT(), (
+		CONVERT(), TMP_MOTH_PATH(), '-crop', CROP(), '-scale', '800%', TMP_QR_PATH()
+	));
+	if ($r != 0) {
+		print STDERR "QR crop fail.\n";
+		exit 1;
+	}
+	$r = system_encoded(ZBARIMG(), (
+		ZBARIMG(), '-q', '--raw', TMP_QR_PATH()
+	));
+	if ($r != 0) {
+		print STDERR "Gene decode fail.\n";
+		exit 1;
+	}
+	unless (open (STDOUT, '>&', $stdout)) {
+		print STDERR "stdout redirect fail.\n";
+		exit 1;
+	}
+}
+
+sub goto_tree {
+	unless (chdir TREE_PATH) {
+		print STDERR "GOTO tree fail.\n";
+		exit 1;
+	}
+}
+
+sub new_branch {
+	(my $name) = @_;
+	
+	my $r = system_encoded(GIT(), (
+		GIT(), 'checkout', '--orphan', $name
+	));
+	if ($r != 0) {
+		print STDERR "Git new branch fail.\n";
+		exit 1;
+	}
+}
+
+sub goto_branch {
+	(my $name) = @_;
+	
+	my $r = system_encoded(GIT(), (
+		GIT(), 'checkout', $name
+	));
+	if ($r != 0) {
+		print STDERR "Git GOTO branch fail.\n";
+		exit 1;
+	}
+}
+
+sub add_branch {
+	(my $name) = @_;
+	
+	my $r = system_encoded(GIT(), (
+		GIT(), 'branch', $name
+	));
+	if ($r != 0) {
+		print STDERR "Git add branch fail.\n";
+		exit 1;
+	}
+}
+
+sub remove_branch {
+	(my $name) = @_;
+	
+	my $r = system_encoded(GIT(), (
+		GIT(), 'branch', '-D', $name
+	));
+	if ($r != 0) {
+		print STDERR "Git remove branch fail.\n";
+		exit 1;
+	}
+}
+
+sub merge_start {
+	(my $name, my $text) = @_;
+	
+	if ($text eq '') {
+		$text = 'x'; # hack
+	}
+	my $r = system_encoded(GIT(), (
+		GIT(), 'merge',
+		'--no-commit', '--allow-unrelated-histories', # '--no-verify',
+		'-s', 'ours', # hack
+		'-m', $text,
+		$name,
+	));
+	if ($r != 0) {
+		print STDERR "Git merge start fail.\n";
+		exit 1;
+	}
+}
+
+sub merge_finish {
+	(my $text) = @_;
+	
+	my $r = system_encoded(GIT(), (
+		GIT(), 'merge', '--continue',
+	));
+	if ($r != 0) {
+		print STDERR "Git merge finish fail.\n";
+		exit 1;
+	}
+	
+	if ($text eq '') { # hack
+		my $r = system_encoded(GIT(), (
+			GIT(), 'commit', '--amend',
+			'--allow-empty-message',
+			'-m', ''
+		));
+		if ($r != 0) {
+			print STDERR "Git name remove fail.\n";
+			exit 1;
+		}
+	}
+}
+
+sub add_moth {
+	
+	unless (copy (TMP_MOTH_PATH(), TREE_MOTH_PATH())) {
+		print STDERR "Copy moth fail.\n";
+		exit 1;
+	}
+	unless (copy (TMP_GENE_PATH(), TREE_GENE_PATH())) {
+		print STDERR "Copy gene fail.\n";
+		exit 1;
+	}
+	unless (copy (TMP_QR_PATH(), TREE_QR_PATH())) {
+		print STDERR "Copy QR fail.\n";
+		exit 1;
+	}
+	my $r = my $r = system_encoded(GIT(), (
+		GIT(), 'add', '.'
+	));
+	if ($r != 0) {
+		print STDERR "Git add fail.\n";
+		exit 1;
+	}
+}
+
+sub commit {
+	(my $text) = @_;
+	
+	my $r = my $r = system_encoded(GIT(), (
+		GIT(), 'commit', '--allow-empty-message', '-m', $text
+	));
+	if ($r != 0) {
+		print STDERR "Git commit fail.\n";
+		exit 1;
+	}
+}