From: b Date: Fri, 14 Mar 2025 02:35:02 +0000 (+0100) Subject: uploader X-Git-Url: http://bicyclesonthemoon.info/git-projects/?a=commitdiff_plain;h=f957cfae2d6af4e1375b68bcb8bababdd697c4ea;p=ott%2Fbsta-tools uploader --- diff --git a/botm-common b/botm-common index 111fb5f..b3ffb0f 160000 --- a/botm-common +++ b/botm-common @@ -1 +1 @@ -Subproject commit 111fb5f38624401ac7f332dd8bf7fa65e7bf5b23 +Subproject commit b3ffb0f0c3c240103a57c98c930d806f748f05a1 diff --git a/makedata.1.pl b/makedata.1.pl index 04b9d6d..ba775db 100755 --- a/makedata.1.pl +++ b/makedata.1.pl @@ -4,7 +4,7 @@ # # make data files from chapter files # -# Copyright (C) 2017, 2019, 2022 Balthasar Szczepański +# Copyright (C) 2017, 2019, 2022, 2025 Balthasar Szczepański # # This program is free software: you can redistribute it and/or modify # it under the terms of the GNU Affero General Public License as diff --git a/makefile b/makefile index 38c8bc3..0e58e39 100644 --- a/makefile +++ b/makefile @@ -30,6 +30,7 @@ SRC_PATH := $(dir $(abspath $(lastword $(MAKEFILE_LIST)))) BASE_PATH := $(abspath $(SRC_PATH)/..) BIN_PATH := $(BASE_PATH)/bin LIB_PATH := $(BASE_PATH)/lib +ETC_PATH := $(BASE_PATH)/etc # CONFIGFILE = settings-bsta.txt settings.txt CONFIGFILE = settings.txt @@ -37,13 +38,16 @@ CONFIGURE_CMD = $(PERL) ./configure.pl --do perl=$(PERL) _base_path=$(BASE_PATH) # keep these 2 lists in the same order!: GENERATE_FROM=\ -makedata.1.pl +makedata.1.pl\ +upload.1.pl TO_GENERATE=\ -makedata.pl +makedata.pl\ +upload.pl EXEC=\ -makedata.pl +makedata.pl\ +upload.pl BIN=\ $(EXEC)\ @@ -52,9 +56,14 @@ typetime LIB=\ botm-common/botm_common.pm +ETC=\ +remote.txt + DIR=\ $(BIN_PATH)\ -$(LIB_PATH) +$(LIB_PATH)\ +$(ETC_PATH) + all: $(BIN) exec @@ -90,10 +99,13 @@ cp_lib: $(LIB) | mktree $(CP) -p $(LIB) $(LIB_PATH) endif -install: all cp_bin cp_lib +cp_etc: $(ETC) | mktree + $(CP) -p $(ETC) $(ETC_PATH) + +install: all cp_bin cp_lib cp_etc clean: $(RM) -f configure.pl $(BIN) -PHONY: all clean install mktree cp_bin cp_lib +PHONY: all clean install mktree cp_bin cp_lib cp_etc diff --git a/remote.txt b/remote.txt new file mode 100644 index 0000000..51a9ec1 --- /dev/null +++ b/remote.txt @@ -0,0 +1,5 @@ +user: b +server: bicyclesonthemoon.info +data-test: /botm/data/test-bsta +data-bsta: /botm/data/bsta +data-again: /botm/data/bstagain diff --git a/settings.txt b/settings.txt index 53d1717..de2eb5a 100644 --- a/settings.txt +++ b/settings.txt @@ -20,9 +20,18 @@ _SHEBANG: #!$0 _attachment_path = @_PATH( $_base_path, att ) _chapter_path = @_PATH( $_base_path, ch ) _data_path = @_PATH( $_base_path, data ) +_etc_path = @_PATH( $_base_path, etc ) _frame_path = @_PATH( $_base_path, frame) +_interface_path = @_PATH( $_base_path, intf ) _lib_path = @_PATH( $_base_path, lib ) +_data_default_path = @_PATH( $_data_path, default ) +_data_noaccess_path = @_PATH( $_data_path, noaccess) +_data_settings_path = @_PATH( $_data_path, settings) + +_etc_remote_path = @_PATH( $_etc_path, remote.txt) + + _PERL_STR: '@_ESCAPE($0,')' _PERL_USE_2: use $0 $1; _PERL_CONSTANT: use constant $0 => $1; @@ -32,9 +41,14 @@ _PERL_CONSTANT_STR: @_PERL_CONSTANT($0,@_PERL_STR($1)) PERL_LIB = @_PERL_USE_2(lib, @_PERL_STR($_lib_path)) -PERL_ATTACHMENT_PATH = @_PERL_CONSTANT_STR( ATTACHMENT_PATH, $_attachment_path) -PERL_CHAPTER_PATH = @_PERL_CONSTANT_STR( CHAPTER_PATH , $_chapter_path ) -PERL_DATA_PATH = @_PERL_CONSTANT_STR( DATA_PATH , $_data_path ) -PERL_FRAME_PATH = @_PERL_CONSTANT_STR( FRAME_PATH , $_frame_path ) +PERL_ATTACHMENT_PATH = @_PERL_CONSTANT_STR( ATTACHMENT_PATH , $_attachment_path ) +PERL_CHAPTER_PATH = @_PERL_CONSTANT_STR( CHAPTER_PATH , $_chapter_path ) +PERL_DATA_PATH = @_PERL_CONSTANT_STR( DATA_PATH , $_data_path ) +PERL_DATA_DEFAULT_PATH = @_PERL_CONSTANT_STR( DATA_DEFAULT_PATH , $_data_default_path ) +PERL_DATA_NOACCESS_PATH = @_PERL_CONSTANT_STR( DATA_NOACCESS_PATH, $_data_noaccess_path) +PERL_DATA_SETTINGS_PATH = @_PERL_CONSTANT_STR( DATA_SETTINGS_PATH, $_data_settings_path) +PERL_ETC_REMOTE_PATH = @_PERL_CONSTANT_STR( ETC_REMOTE_PATH , $_etc_remote_path ) +PERL_FRAME_PATH = @_PERL_CONSTANT_STR( FRAME_PATH , $_frame_path ) +PERL_INTERFACE_PATH = @_PERL_CONSTANT_STR( INTERFACE_PATH , $_interface_path ) RUN_PERL = @_SHEBANG($perl) diff --git a/upload.1.pl b/upload.1.pl new file mode 100644 index 0000000..400678a --- /dev/null +++ b/upload.1.pl @@ -0,0 +1,499 @@ +###RUN_PERL: #!/usr/bin/perl + +# upload.pl is generated from upload.1.pl. +# +# make data files from chapter files +# +# Copyright (C) 2025 Balthasar Szczepański +# +# This program is free software: you can redistribute it and/or modify +# it under the terms of the GNU Affero General Public License as +# published by the Free Software Foundation, either version 3 of the +# License, or (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU Affero General Public License for more details. +# +# You should have received a copy of the GNU Affero General Public License +# along with this program. If not, see . + +use strict; +use utf8; +use Encode::Locale ('decode_argv'); +use Encode ('encode', 'decode'); + +###PERL_LIB: use lib ~/ott/bsta/lib +use botm_common ( + 'join_path', + 'read_data_file', 'write_data_file', + 'system_encoded', '_x_encoded', + 'merge_settings' +); + +binmode STDIN, ':encoding(UTF-8)'; +binmode STDOUT, ':encoding(UTF-8)'; +binmode STDERR, ':encoding(UTF-8)'; +decode_argv(); + +my $time = time(); +srand ($time-$$); + +###PERL_ATTACHMENT_PATH: ATTACHMENT_PATH = ~/ott/bsta/att +###PERL_DATA_PATH: DATA_PATH = ~/ott/bsta/data +###PERL_DATA_DEFAULT_PATH: DATA_DEFAULT_PATH = ~/ott/bsta/data/default +###PERL_DATA_NOACCESS_PATH: DATA_NOACCESS_PATH = ~/ott/bsta/data/noaccess +###PERL_DATA_SETTINGS_PATH: DATA_SETTINGS_PATH = ~/ott/bsta/data/settings +###PERL_ETC_REMOTE_PATH: ETC_REMOTE_PATH = ~/ott/bsta/etc/remote.txt +###PERL_FRAME_PATH: FRAME_PATH = ~/ott/bsta/frame +###PERL_INTERFACE_PATH: INTERFACE_PATH = ~/ott/bsta/data/intf + +my $fail = 0; +my %remote; +my %settings; +my %default; +my %state; +my $target; +my $server; +my $current_frame; +my $last_frame; +my @upload_list; + +print $time." UPLOAD\n"; + +if (@ARGV < 1) { + print STDERR "no remote target\n"; + print "FAIL\n"; + exit 1; +} + +$target = 'data-'.shift(@ARGV); + +%remote = read_data_file(ETC_REMOTE_PATH()); +unless ( + (exists $remote{'server'}) and + (exists $remote{'user' }) and + (exists $remote{$target }) +) { + print STDERR "didn't get remote target\n"; + print "FAIL\n"; + exit 1; +} + +$server = $remote{'user'}.'@'.$remote{'server'}; +$target = $remote{$target }; + +%settings = read_data_file(DATA_SETTINGS_PATH()); +if (%settings == 0) { + print STDERR "didn't read settings\n"; + print "FAIL\n"; + exit 1; +} +%default = read_data_file(DATA_DEFAULT_PATH()); +if (%default == 0) { + print STDERR "didn't read default\n"; + print "FAIL\n"; + exit 1; +} +%state = read_data_file( + ['ssh', $server, '-t', 'cat '.join_path('/', $target, 'state').' 2>/dev/null'], '', + '', '', '', + '-|', '' +); +if (%state == 0) { + print STDERR "didn't read state\n"; + print "FAIL\n"; + exit 1; +} +$current_frame = (int($state{'state'}) > 0) ? int($state{'last'}) : -1; +$last_frame = int($settings{'last'}); + +foreach my $id (@ARGV) { + if ($id eq 'all') { + upload_settings(\@upload_list); + upload_interface(\@upload_list); + upload_default(\@upload_list); + upload_noaccess(\@upload_list, 1, 1); + for (my $f=0; $f<=$last_frame; $f+=1) { + upload_frame(\@upload_list, $f, 1, 1); + } + for (my $a=0; upload_attachment(\@upload_list, $a, 1, 1); $a+=1) { + } + } + elsif ($id =~ /^([df]?)([0-9]+)$/) { + my $f = int($2); + my $data = (($1 eq 'd') or ($1 eq '')); + my $file = (($1 eq 'f') or ($1 eq '')); + if ($f > $last_frame) { + print "$f > $last_frame\n"; + $fail += 1; + next; + } + upload_frame(\@upload_list, $f, $data, $file); + } + elsif ($id =~ /^([df]?)([\-+])$/) { + my $f_start = ($2 eq '+') ? ($current_frame+1) : 0; + my $f_end = ($2 eq '+') ? $last_frame : $current_frame; + my $data = (($1 eq 'd') or ($1 eq '')); + my $file = (($1 eq 'f') or ($1 eq '')); + for (my $f=$f_start; $f<=$f_end; $f+=1) { + if ($f > $last_frame) { + print "$f > $last_frame\n"; + $fail += 1; + next; + } + upload_frame(\@upload_list, $f, $data, $file); + } + } + elsif ($id =~ /^(([df]?)([0-9]+))?([\-+])(([df]?)([0-9]+))?$/) { + my $f_start; + my $f_end; + my $df; + my $data; + my $file; + + if (($1 ne '') && ($5 ne '')) { + if ($4 eq '+') { + print $id." ???\n"; + $fail += 1; + next; + } + if ($2 ne $6) { + print $2.' =/= '.$6."\n"; + $fail += 1; + next; + } + $f_start = int($3); + $f_end = int($7); + $df = $2; + } + elsif ($1 ne '') { + $f_start = int($3); + $f_end = (($4 eq '-') ? $current_frame : $last_frame); + $df = $2; + } + elsif ($5 ne '') { + $f_start = (($4 eq '+') ? ($current_frame + 1) : 0); + $f_end = int($7); + $df = $6; + } + else { + print $id." ???\n"; + $fail += 1; + next; + } + if ($f_start > $last_frame) { + print "$f_start > $last_frame\n"; + $fail += 1; + next; + } + if ($f_start > $f_end) { + print "$f_start > $f_end\n"; + $fail += 1; + next; + } + $data = (($df eq 'd') or ($df eq '')); + $file = (($df eq 'f') or ($df eq '')); + for (my $f=$f_start; $f<=$f_end; $f+=1) { + if ($f > $last_frame) { + print "$f > $last_frame\n"; + $fail += 1; + next; + } + upload_frame(\@upload_list, $f, $data, $file); + } + } + elsif ($id =~ /^[df_]$/) { + my $data = (($& eq 'd') or ($& eq '_')); + my $file = (($& eq 'f') or ($& eq '_')); + for (my $f=0; $f<=$last_frame; $f+=1) { + upload_frame(\@upload_list, $f, $data, $file); + } + } + elsif ($id =~ /^a([df]?)([0-9]+)$/) { + my $a = int($2); + my $data = (($1 eq 'd') or ($1 eq '')); + my $file = (($1 eq 'f') or ($1 eq '')); + my $r = upload_attachment(\@upload_list, $a, $data, $file); + unless ($r) { + print '!a'.$a."\n"; + $fail += 1; + next; + } + } + elsif ($id =~ /^(a([df]?)([0-9]+))?([\-+])(a([df]?)([0-9]+))?$/) { + my $a_start; + my $a_end; + my $df; + my $data; + my $file; + + if (($1 ne '') && ($5 ne '')) { + if ($4 eq '+') { + print $id." ???\n"; + $fail += 1; + next; + } + if ($2 ne $6) { + print $2.' =/= '.$6."\n"; + $fail += 1; + next; + } + $a_start = int($3); + $a_end = int($7); + $df = $2; + } + elsif ($1 ne '') { + if ($4 eq '-') { + print $id." ???\n"; + $fail += 1; + next; + } + $a_start = int($3); + $a_end = ~0; + $df = $2; + } + elsif ($5 ne '') { + if ($4 eq '+') { + print $id." ???\n"; + $fail += 1; + next; + } + $a_start = 0; + $a_end = int($7); + $df = $6; + } + else { + print $id." ???\n"; + $fail += 1; + next; + } + if ($a_start > $a_end) { + print "$a_start > $a_end\n"; + $fail += 1; + next; + } + $data = (($df eq 'd') or ($df eq '')); + $file = (($df eq 'f') or ($df eq '')); + for (my $a=$a_start; $a<=$a_end; $a+=1) { + my $r = upload_attachment(\@upload_list, $a, $data, $file); + unless ($r) { + if (($a_end == ~0) && ($a != $a_start)) { + last; + } + print '!a'.$a."\n"; + $fail += 1; + next; + } + } + } + elsif ($id =~ /^a([df]?)$/) { + my $data = (($1 eq 'd') or ($1 eq '')); + my $file = (($1 eq 'f') or ($1 eq '')); + for (my $a=0; upload_attachment(\@upload_list, $a, $data, $file); $a+=1) { + } + } + elsif ($id eq 't') { + upload_default(\@upload_list); + } + elsif ($id =~ /^n([df]?)$/) { + my $data = (($1 eq 'd') or ($1 eq '')); + my $file = (($1 eq 'f') or ($1 eq '')); + upload_noaccess(\@upload_list, $data, $file); + } + elsif ($id eq 'i') { + upload_interface(\@upload_list); + } + elsif ($id eq 's') { + upload_settings(\@upload_list); + } + else { + print $id." ???\n"; + $fail += 1; + } + +} + +foreach my $upload (@upload_list) { + my $r; + my $remote_server_path = $server.':'.$upload->{'remote_path'}; + print "\n".$upload->{'local_path'}.' -> '.$remote_server_path."\n"; + + if ($upload->{'special'}) { + my %data = read_data_file($upload->{'local_path'}); + if (%data == 0) { + print STDERR 'didn\'t read '.$upload->{'local_path'}."\n"; + print "FAIL\n"; + $fail += 1; + next; + } + my %remote_data = read_data_file( + ['ssh', $server, '-t', 'cat '.$upload->{'remote_path'}.' 2>/dev/null'], '', + '', '', '', + '-|', '' + ); + if ((%remote_data == 0) && ($upload->{'frame'} <= $current_frame)) { + print STDERR 'didn\'t read '.$remote_server_path."\n"; + print "FAIL\n"; + $fail += 1; + next; + } + foreach my $key ('ongtime', 'timer', 'ott') { + if (defined $remote_data{$key}) { + $data{$key} = $remote_data{$key}; + } + } + $r = write_data_file( + ['ssh', $server, '-t', 'cat > '.$upload->{'remote_path'}], \%data, '', + '', '', '', + '|-', '' + ); + unless ($r) { + print STDERR 'didn\'t write '.$remote_server_path."\n"; + print "FAIL\n"; + $fail += 1; + next; + } + } + else { + my @cmd = ('scp', 'scp', $upload->{'local_path'}, $remote_server_path); + $r = system_encoded(@cmd); + unless ($r == 0) { + print STDERR 'didn\'t upload '.$remote_server_path."\n"; + print "FAIL\n"; + $fail += 1; + next; + } + } + print "OK\n"; +} +print (($fail > 0) ? "\nFAIL\n" : "\nOK\n"); +exit $fail; + +sub upload_settings { + (my $upload_list) = @_; + push @$upload_list, { + 'local_path' => DATA_SETTINGS_PATH(), + 'remote_path' => join_path('/', $target, 'settings'), + 'special' => 0 + }; +} + +sub upload_default { + (my $upload_list) = @_; + push @$upload_list, { + 'local_path' => DATA_DEFAULT_PATH(), + 'remote_path' => join_path('/', $target, 'default'), + 'special' => 0 + }; +} + +sub upload_noaccess { + (my $upload_list, my $data, my $file) = @_; + if ($data) { + push @$upload_list, { + 'local_path' => DATA_NOACCESS_PATH(), + 'remote_path' => join_path('/', $target, 'noaccess'), + 'special' => 0 + }; + } + if ($file) { + my %noaccess_data = read_data_file(DATA_NOACCESS_PATH()); + %noaccess_data = merge_settings(\%default, \%noaccess_data); + $file = $noaccess_data{'frame'}; + push @$upload_list, { + 'local_path' => join_path('/', FRAME_PATH(), $file), + 'remote_path' => join_path('/', $target , $file), + 'special' => 0 + }; + } +} + +sub upload_frame { + (my $upload_list, my $id, my $data, my $file) = @_; + $id = int($id); + my $path = join_path('/', DATA_PATH(), $id); + if ($data) { + push @$upload_list, { + 'local_path' => $path, + 'remote_path' => join_path('/', $target, $id), + 'special' => 1, + 'frame' => $id + }; + } + if ($file) { + my %frame_data = read_data_file($path); + %frame_data = merge_settings(\%default, \%frame_data); + $file = ( + ($frame_data{'frame'} ne '') ? + $frame_data{'frame'} : + sprintf($settings{'frame'}, $id, $frame_data{'ext'}) + ); + push @$upload_list, { + 'local_path' => join_path('/', FRAME_PATH(), $file), + 'remote_path' => join_path('/', $target , $file), + 'special' => 0 + }; + } +} + +sub upload_attachment { + (my $upload_list, my $id, my $data, my $file) = @_; + $id = 'a'.int($id); + my $path = join_path('/', DATA_PATH(), $id); + unless (_x_encoded('-f', $path)) { + return 0; + } + if ($data) { + push @$upload_list, { + 'local_path' => $path, + 'remote_path' => join_path('/', $target, $id), + 'special' => 0 + }; + } + if ($file) { + my %attachment_data = read_data_file($path); + unless (($attachment_data{'filename'} eq '') or ($attachment_data{'content'} ne '')) { + $file = $attachment_data{'filename'}; + push @$upload_list, { + 'local_path' => join_path('/', ATTACHMENT_PATH(), $file), + 'remote_path' => join_path('/', $target , $file), + 'special' => 0 + }; + } + } + return 1; +} + +sub upload_interface { + (my $upload_list) = @_; + foreach my $file ( + 'intf-00.gif', + 'intf-00_04.gif', + 'intf-00_08.gif', + 'intf-00_10.gif', + 'intf-01.gif', + 'intf-01_.gif', + 'intf-02.gif', + 'intf-02_.gif', + 'intf-04.gif', + 'intf-04_.gif', + 'intf-08.gif', + 'intf-08_.gif', + 'intf-10.gif', + 'intf-10_.gif', + 'intf-20.gif', + 'intf-20_.gif', + 'intf-kw.gif', + 'intf-ll.gif', + 'intf-pp.gif', + 'intf-tr.gif', + ) { + push @$upload_list, { + 'local_path' => join_path('/', INTERFACE_PATH(), $file), + 'remote_path' => join_path('/', $target , $file), + 'special' => 0 + }; + } +}