--- /dev/null
+###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 <http://www.gnu.org/licenses/>.
+
+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
+ };
+ }
+}
bicyclesonthemoon.info / projects / ott / bsta-tools / commitdiff