From: b 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; + } +}