tool seems ready

diff --git a/moth.pl b/moth.pl
new file mode 100755 (executable)
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;
+       }
+}