if {[gets $f l] < 0} { error "huh?" }
}
+proc read_counted {f var} {
+ upvar 1 $var var
+ must_gets $f count
+ set var [read $f $count]
+ if {[eof $f]} { error ? }
+}
+
#---------- display core ----------
set mul 6
done/$mainkind
}
+#========== server for approving updates ==========
+
+proc remote-serv-log {pirate event} {
+ set t [clock format [clock seconds] -format {%Y-%m-%d %H:%M:%S %Z}]
+ set s [format "%s %15s %s" $t $pirate $event]
+}
+
+proc remote-serv/list {} {
+ global dropdir
+ foreach file [glob -nocomplain -type f -directory $dropdir _update.*.rdy] {
+ puts yes
+ puts $file
+ set f [open $file]
+ set d [read $f]
+ close $f
+ puts [string length $d]
+ puts -nonewline $d
+ }
+ puts end
+}
+
+proc remote-serv/take {f args} {
+ global dropdir rows reqkind
+ set rows ""
+ manyset $args yesno file pirate reqkind rows
+ read_counted stdin desc
+ read_counted stdin key
+ read_counted stdin val
+ if {$yesno} {
+ read_database
+ set database($key) $val
+ write_database
+ }
+ set ar [lindex {reject approve} $yesno]
+ remote-serv-log $pirate "$ar $reqkind $rows $desc"
+ file remove $file
+}
+
+proc main/remoteserv {} {
+ global argv dropdir
+ manyset $argv dropdir
+ while 1 {
+ puts {ypp-sc-tools pctb remote-server v1}
+ if {[gets stdin l] < 0} break
+ eval remote-serv/$l
+ }
+}
+
#========== main program ==========
proc main/default {} {
proc debug {m} { }
set mainkind default
+set ai 0
foreach arg $argv {
+ incr ai
switch -exact -- $arg {
- {--debug} { proc debug {m} { puts stderr "SHOW-THING $m" } }
- {--noop-arg} { }
- {--automatic-1} { set mainkind automatic }
- {--automatic*} { error "incompatible versions - install problem" }
- default { error "huh $argv ?" }
+ {--debug} { proc debug {m} { puts stderr "SHOW-THING $m" } }
+ {--noop-arg} { }
+ {--automatic-1} { set mainkind automatic }
+ {--remote-server-1} { set mainkind remoteserv; break }
+ {--automatic*} - {--remote-server}
+ { error "incompatible versions - install problem" }
+ default { error "huh $argv ?" }
}
}
+set argv [lrange $argv $ai end]
main/$mainkind
sub parseentryin__pixmap ($) {
my ($entry_in) = @_;
$entry_in =~
- m/^(\w+ \- \w[-+'"#! 0-9a-z]*)\nP3\n([1-9]\d{1,3}) ([1-9]\d{1,3})\n255\n/s or die; # ']);
+ m/^(\w+ \- \w[-+\'\"\#! 0-9a-z]*)\nP3\n([1-9]\d{1,3}) ([1-9]\d{1,3})\n255\n/s or die;
my ($def,$w,$h)= ($1, $2+0, $3+0);
my @d= grep { m/./ } split /\s+/, $';
@d == $w*$h*3 or die "$d[0]|$d[1]|...|$d[$#d-1]|$d[$#d] ?";
my $entry_in= param('entry');
defined $entry_in or die;
-my $owner= `whoami`; $? and die $?;
-chomp $owner;
+my $du=$ENV{'YPPSC_DICTUPDATES'};
+chdir $du or die "$du $!"
+ if defined $du;
my $kind;
my ($ctx,$def,$entry,$icon,$width,$whole)= &{"parseentryin__$kind"}($entry_in);
+my $fn_t= "_update.$$-xxxxxxxxxxxxxxxx.tmp";
+open F, "> $fn_t" or die "$fn_t $!";
+(stat F) or die $!;
+my $fn_i= sprintf "_update.$$-%016x.rdy", (stat _)[1];
+
+print F $whole or die $!;
+close F or die $!;
+rename $fn_t, $fn_i or die "$fn_t $fn_i $!";
+
+__END__
+
$icon =~ s/^/ /mg;
my $email= <<END