From: Ian Jackson Date: Sat, 14 Nov 2009 17:29:52 +0000 (+0000) Subject: Merge branch 'stable-5.x' X-Git-Tag: 6.0~2 X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?p=ypp-sc-tools.main.git;a=commitdiff_plain;h=c98eb3b0720f8194a116aea338fd2d3caa8c7538;hp=df355607394d8ef474b922122e5a65bd0eac7c44 Merge branch 'stable-5.x' --- diff --git a/yarrg/Commods.pm b/yarrg/Commods.pm index e63126a..9178112 100644 --- a/yarrg/Commods.pm +++ b/yarrg/Commods.pm @@ -37,10 +37,10 @@ BEGIN { @ISA = qw(Exporter); @EXPORT = qw(&parse_info_clientside &fetch_with_rsync &parse_info_serverside &parse_info_serverside_ocean - %oceans %commods %clients + %oceans %commods %clients %commodclasses %vessels %shotname2damage &parse_pctb_commodmap %pctb_commodmap @pctb_commodmap - &get_our_version &check_tsv_line + &get_our_version &check_tsv_line &errsan &pipethrough_prep &pipethrough_run &pipethrough_run_along &pipethrough_run_finish &pipethrough_run_gzip &http_useragent &version_core @@ -94,12 +94,16 @@ our %commods; # eg $commods{'Fine black cloth'}{Srcs}= $sources; # eg $commods{'Fine black cloth'}{Mass}= 700 [g] # eg $commods{'Fine black cloth'}{Volume}= 1000 [ml] +# eg $commods{'Fine black cloth'}{Ordval}= 203921 our (%pctb_commodmap,@pctb_commodmap); my %colours; # eg $colours{'c'}{'black'}= $sources my (@rawcm, @nocm); # eg $rawcm[0]='fine rum'; $rawcm[1]='fine %c cloth' +my %colour_ordvals; # $colour_ordvals{'c'}{'green'}= '30'; +our %commodclasses; # $commodclasses{'dye'}= '3'; + # IMPORTANT # when extending the format of source-info in a non-backward # compatible way, be sure to update update-master-info too. @@ -118,11 +122,24 @@ sub parse_info1 ($$$) { s/\s+$//; if (m/^\%(\w+)$/) { my $colourkind= $1; - @ctx= (sub { $colours{$colourkind}{lc $_} .= $src; }); + @ctx= (sub { + m/^(\S[^\t@]*\S)(?:\t+\@(\d+\+?))?$/ or die "$_ ?"; + my ($colour,$order)=($1,$2); + $colours{$colourkind}{$colour} .= $src; + if (defined $order) { + $order =~ s/^(\d+)\+$/ $1 + $. * 10 /e; + $colour_ordvals{$colourkind}{$colour}= $order; + } + }); } elsif (m/^commods$/) { @ctx= (sub { push @rawcm, lc $_; }); } elsif (m/^nocommods$/) { @ctx= (sub { push @nocm, lc $_; }); + } elsif (m/^commodclasses$/) { + @ctx= (sub { + die unless m/^\*([_a-z]+)$/; + $commodclasses{$1}= scalar keys %commodclasses; + }); } elsif (m/^ocean (\w+)$/) { my $ocean= $1; keys %{ $oceans{$ocean} }; @@ -177,36 +194,57 @@ sub parse_info1 ($$$) { %commods= (); my $ca; + my $lnoix=0; $ca= sub { - my ($s,$ss) = @_; -#print "ca($s)\n"; + my ($s,$ss,$ordbase) = @_; +#print STDERR "ca($s,,".(defined $ordbase ? $ordbase : '?').")\n"; if ($s !~ m/\%(\w+)/) { my ($name, $props) = $s =~ - /^(\S[^\t]*\S)(?:\t+(\S[^\t]*\S))?$/ + /^(\S[^\t]*\S)(?:\t+(\S.*\S))?$/ or die "bad commodspec $s"; return if grep { $name eq $_ } @nocm; my $ucname= ucfirst $name; $commods{$ucname}{Srcs} .= $ss; my $c= $commods{$ucname}; $c->{Volume}= 1000; + my ($ordval, $ordclassval); foreach my $prop (defined $props ? split /\s+/, $props : ()) { if ($prop =~ m/^([1-9]\d*)(k?)g$/) { $c->{Mass}= $1 * ($2 ? 1000 : 1); - } elsif ($prop =~m/^([1-9]\d*)l$/) { + } elsif ($prop =~ m/^([1-9]\d*)l$/) { $c->{Volume}= $1 * 1000; + } elsif ($prop =~ m/^\*([_a-z]+)$/) { + $c->{Class}= $1; + die "$1" unless exists $commodclasses{$1}; + $ordclassval= 1e7 + $commodclasses{$1} * 1e7; + } elsif ($prop =~ m/^\@(\d+\+?)$/) { + $ordval= $1; + $ordval =~ s/^(\d+)\+$/ $1 + $lnoix * 10 /e; } else { die "unknown property $prop for $ucname"; } } + $c->{ClassOrdval}= $ordclassval; + if (defined $ordbase && defined $ordval && defined $ordclassval) { + my $ordvalout= $ordbase + $ordval + $ordclassval; + $c->{Ordval}= $ordvalout; +#print STDERR "ordval $ordvalout $name OV=$ordval OB=$ordbase OCV=$ordclassval\n"; + } else { +#print STDERR "ordval NONE $name\n"; + } return; } die "unknown $&" unless defined $colours{$1}; my ($lhs,$pctlet,$rhs)= ($`,$1,$'); foreach my $c (keys %{ $colours{$pctlet} }) { - &$ca($lhs.$c.$rhs, $ss .'%'. $colours{$pctlet}{$c}); + my $ordcolour= $colour_ordvals{$pctlet}{$c}; + &$ca($lhs.$c.$rhs, + $ss .'%'. $colours{$pctlet}{$c}, + defined($ordbase) && defined($ordcolour) + ? $ordbase+$ordcolour : undef); } }; - foreach (@rawcm) { &$ca($_,$src); } + foreach (@rawcm) { $lnoix++; &$ca($_,$src,0); } } sub parse_info_clientside () { @@ -369,6 +407,12 @@ sub cgipostform ($$$) { our %check_tsv_done; +sub errsan ($) { + my ($value) = @_; + $value =~ s/[^-+\'. A-Za-z0-9]/ sprintf "\\x%02x",ord $& /ge; + return "\"$value\""; +} + sub check_tsv_line ($$) { my ($l, $bad_data_callback) = @_; my $bad_data= sub { &$bad_data_callback("bad data: line $.: $_[0]"); }; @@ -382,15 +426,19 @@ sub check_tsv_line ($$) { !keys %commods or defined $commods{$commod} or - &$bad_data("unknown commodity \`$commod'"); + &$bad_data("unknown commodity ".errsan($commod)); - $stall =~ m/^\p{IsUpper}|^[0-9]/ or &$bad_data("stall not capitalised"); - !exists $check_tsv_done{$commod,$stall} or &$bad_data("repeated data"); + $stall =~ m/^\p{IsUpper}|^[0-9]/ or + &$bad_data("stall not capitalised ".errsan($stall)); + !exists $check_tsv_done{$commod,$stall} or + &$bad_data("repeated data ".errsan($commod).",".errsan($stall)); $check_tsv_done{$commod,$stall}= 1; foreach my $i (2..5) { my $f= $v[$i]; - $f =~ m/^(|0|[1-9][0-9]{0,5}|\>1000)$/ or &$bad_data("bad field $i"); - ($i % 2) or ($f !~ m/\>/) or &$bad_data("> in field $i price"); + $f =~ m/^(|0|[1-9][0-9]{0,5}|\>1000)$/ or + &$bad_data("bad field $i ".errsan($f)); + ($i % 2) or ($f !~ m/\>/) or + &$bad_data("> in field $i price ".errsan($f)); } foreach my $i (2,4) { diff --git a/yarrg/CommodsDatabase.pm b/yarrg/CommodsDatabase.pm index c510080..3cb543d 100644 --- a/yarrg/CommodsDatabase.pm +++ b/yarrg/CommodsDatabase.pm @@ -45,7 +45,9 @@ BEGIN { @ISA = qw(Exporter); @EXPORT = qw(&db_setocean &db_writer &db_connect $dbh &db_filename &db_doall &db_onconflict - &dbr_filename &dbr_connect &db_connect_core); + &dbr_filename &dbr_connect &db_connect_core + &dumptab_head &dumptab_row_hashref + &db_chkcommit &db_check_referential_integrity); %EXPORT_TAGS = ( ); @EXPORT_OK = qw(); @@ -119,4 +121,150 @@ sub db_doall ($) { } } +#---------- table dump helper ---------- + +sub dumptab_head ($$$) { + my ($fh,$w,$cols) = @_; + printf $fh "|%-${w}s", $_ foreach @$cols; print $fh "|\n"; + print $fh "+",('-'x$w) foreach @$cols; print $fh "+\n"; +} + +sub dumptab_row_hashref ($$$$) { + my ($fh,$w,$cols,$row) = @_; + printf $fh "|%-$w.${w}s", + (defined $row->{$_} ? $row->{$_} : 'NULL') + foreach @$cols; + print $fh "\n"; +} + +#---------- referential integrity constraints ---------- + +# SQLite doesn't support foreign key constraints so we do it by steam: + +sub nooutput ($) { + my ($stmts) = @_; + my $ekindcount= 0; + my $letxt= ''; + foreach my $stmt (split /\;/, $stmts) { + next unless $stmt =~ /\S/; + + my $etxt= ''; + $stmt =~ s/^([ \t]*\#.*)$/ $etxt .= $1."\n"; ''; /mge; + $etxt= $letxt unless length $etxt; + $letxt= $etxt; + + $stmt =~ s/^\s+//; $stmt =~ s/\s+$//; + my $sth= $dbh->prepare($stmt); + $sth->execute(); + my $row; + my $ecount= 0; + my @cols= @{ $sth->{NAME_lc} }; + my $w= 11; + while ($row= $sth->fetchrow_hashref) { + if (!$ecount++) { + print STDERR "REFERENTIAL INTEGRITY ERROR\n"; + print STDERR "\n$etxt\n $stmt\n\n"; + dumptab_head(\*STDERR,$w,\@cols); + } + if ($ecount>5) { print STDERR "...\n"; last; } + dumptab_row_hashref(\*STDERR,$w,\@cols,$row); + } + next unless $ecount; + + $ekindcount++; + print STDERR "\n\n"; + } + die "REFERENTIAL INTEGRITY ERRORS $ekindcount\n" + if $ekindcount; +} + +sub db_check_referential_integrity ($) { + my ($full) = @_; + # non-full is done only for market data updates; it avoids + # detecting errors which are essentially missing metadata and + # old schemas, etc. + + foreach my $bs (qw(buy sell)) { + nooutput(< 0 + GROUP BY ordval + HAVING count(*) > 1; + + # For every class, posinclass is dense from 1 to maxposinclass, + # apart from the commods for which it is zero. + SELECT commodclass,commodclassid,posinclass,count(*) + FROM commods NATURAL JOIN commodclasses + WHERE posinclass > 0 + GROUP BY commodclassid,posinclass + HAVING count(*) > 1; + SELECT commodclass,commodclassid,count(*) + FROM commods NATURAL JOIN commodclasses + WHERE posinclass > 0 + GROUP BY commodclassid + HAVING count(*) != maxposinclass; + SELECT * + FROM commods NATURAL JOIN commodclasses + WHERE posinclass < 0 OR posinclass > maxposinclass; + +END + } +} + +sub db_chkcommit ($) { + my ($full) = @_; + db_check_referential_integrity($full); + $dbh->commit(); +} + 1; diff --git a/yarrg/TODO b/yarrg/TODO index 8e85c93..e8edb94 100644 --- a/yarrg/TODO +++ b/yarrg/TODO @@ -1,8 +1,6 @@ UPLOADER -------- -detect all unexpected mouse movements - more flexible installation arrangements windows uploader @@ -10,13 +8,6 @@ windows uploader DATABASE/DICTIONARY MANAGER --------------------------- -eliminate black dye from live database - -when update rejected print better error message including - broken commodity name - -notice commodities deleted from source-info and warn about them - support Opal and Jade (currently there are some unicode problems) WEBSITE @@ -28,3 +19,13 @@ initial/final stocks feature query_routesearch should show capital for each voyage query_routesearch should support ending in specific place(s) + + +USEFUL WEBSITE UI SUGGESTIONS +----------------------------- + +Change loss per league to always be percentage and not to require % to +be typed. Put % sign in HTML after the entry box ? + +15:59 font size=-3 for the license info at the bottom +would also be good diff --git a/yarrg/commod-email-processor b/yarrg/commod-email-processor index 1cff462..a75864a 100755 --- a/yarrg/commod-email-processor +++ b/yarrg/commod-email-processor @@ -195,7 +195,7 @@ sub main () { pipethrough_run_finish($pt, 'gunzip <$deduped_tsv.gz'); # print "\n"; - $dbh->commit(); + db_chkcommit(0); # select * from ((buy natural join commods) natural join stalls) natural join islands; # select * from ((sell natural join commods) natural join stalls) natural join islands; diff --git a/yarrg/commod-results-processor b/yarrg/commod-results-processor index 37484d6..8ede371 100755 --- a/yarrg/commod-results-processor +++ b/yarrg/commod-results-processor @@ -39,7 +39,7 @@ use Commods; # $commod{'Hemp'}{Hold} our @v; -our ($commod,$stall,%commod); +our ($commod,$stall,%commod,@commods_inorder); @ARGV==1 or die "You probably don't want to run this program directly.\n"; our ($mode) = shift @ARGV; @@ -69,6 +69,7 @@ while (<>) { die "$_ ?" if m/.\D/; } ($commod,$stall) = @v; + push @commods_inorder, $commod unless exists $commod{$commod}; bs_read(Buy, 2); bs_read(Sell, 4); $commod{$commod}{Hold}= $v[6]+0 if @v>6; @@ -234,6 +235,41 @@ sub main__tsv () { write_tsv(\*STDOUT,1); } +sub undef_printable { my ($ov)= @_; defined $ov ? $ov : '?'; }; + +sub commodsinorder_print1 ($$) { + my ($keyword,$commod) = @_; + printf("%s\t%-40s %10s %s", + $keyword, + $commod, + undef_printable($commods{$commod}{Ordval}), + undef_printable($commods{$commod}{Class})) + or die $!; +} + +sub main__commodsinorder () { + parse_info_serverside(); + my $last_ov; + foreach my $commod (@commods_inorder) { + my $ov= $commods{$commod}{Ordval}; + commodsinorder_print1('found',$commod); + if (defined $ov) { + if (defined $last_ov && $ov <= $last_ov) { + print " out-of-order" or die $!; + } + $last_ov= $ov; + } + print "\n" or die $!; + } + foreach my $commod (sort { + undef_printable($commods{$a}{Ordval}) cmp + undef_printable($commods{$b}{Ordval}) + } keys %commods) { + next if exists $commod{$commod}; + commodsinorder_print1('none',$commod); + print "\n" or die $!; + } +} our ($pctb) = $ENV{'YPPSC_YARRG_PCTB'}; diff --git a/yarrg/commod-update-receiver b/yarrg/commod-update-receiver index 0ae5ba8..2059ad7 100755 --- a/yarrg/commod-update-receiver +++ b/yarrg/commod-update-receiver @@ -93,7 +93,7 @@ addlog("receiving"); $o{'clientname'}= must_param('clientname',$re_any); my $clientinfo= $clients{$o{'clientname'}}; -fail('unknown client') unless defined $clientinfo; +fail('unknown client '.errsan($o{'clientname'})) unless defined $clientinfo; my $clientfixes= must_param('clientfixes', "^([-0-9a-z ]*)\$"); my @clientfixes= sort grep { m/./ } split /\s+/, $clientfixes; @@ -115,7 +115,7 @@ $o{'ocean'}= must_param('ocean', $re_any); $o{'island'}= must_param('island', $re_any); my $arches= $oceans{$o{'ocean'}}; -fail("unknown ocean") unless $arches; +fail("unknown ocean ".errsan($o{'ocean'})) unless $arches; parse_info_serverside_ocean($o{'ocean'}); @@ -126,7 +126,7 @@ foreach my $islands (values %$arches) { die if $island_found; $island_found= $sources; } -fail("unknown island") unless $island_found; +fail("unknown island ".errsan($o{'island'})) unless $island_found; $o{'timestamp'}= must_param('timestamp', "^([1-9]\\d{1,20})\$"); fail("clock skew") if $o{'timestamp'} > $now; diff --git a/yarrg/db-idempotent-populate b/yarrg/db-idempotent-populate index 0ecde9e..bb0448c 100755 --- a/yarrg/db-idempotent-populate +++ b/yarrg/db-idempotent-populate @@ -36,9 +36,17 @@ use DBI; use Commods; use CommodsDatabase; +my $trace=0; +while (@ARGV and $ARGV[0] eq '-D') { + $trace++; + shift @ARGV; +} + @ARGV==1 or die; my ($oceanname) = @ARGV; +$|=1; + #---------- setup ---------- parse_info_serverside(); @@ -47,107 +55,379 @@ db_setocean($oceanname); db_writer(); db_connect(); -#---------- schema ---------- +$dbh->trace(1) if $trace; + + +#---------- schema update code ---------- + +our @need_compact; +our @need_transfer_back; + +our %table; + +sub table ($$) { + my ($table, $fields) = @_; + table_maycompact($table,undef,undef,$fields); +} + +sub table_maycompact ($$$$) { + my ($table, $cpact_idfield, $cpact_needupdates, $fields) = @_; + + #----- parse $fields ----- + + my @want_fields; + my @want_field_specs; + my %want_field_specs; + + foreach my $fspec (split /\n/, $fields) { + next unless $fspec =~ m/\S/; + if ($fspec =~ m/^\s*\+/) { + push @want_field_specs, "\t".$'; + next; + } elsif ($fspec =~ m/^\s*(\w+)(\s+)(\w.*\S)\s*$/) { + my ($f,$spaces,$rhs) = ($1,$2,$3); + my $spec= "\t".$f.$spaces.$rhs; + push @want_fields, $f; + push @want_field_specs, $spec; + $want_field_specs{$f}= $spec; + } else { + die "$table $fspec ?"; + } + } + + my $want_field_specs= join ",\n", @want_field_specs; + + #----- ensure table exists ----- + + db_doall(<prepare(<execute($table,$table); + my ($sql)= $autoinc->fetchrow_array(); + die unless defined $sql; + push @need_recreate, 'remove autoinc' + if $sql =~ m/\bautoinc/i; + } + + #----- check whether we need to add fields ----- + + my $check= $dbh->prepare("SELECT * FROM $table LIMIT 1"); + $check->execute(); + my %have_fields; + $have_fields{$_}=1 foreach @{ $check->{NAME_lc} }; + $check->finish(); + + my @have_fields; + my @aside_fields; + my @have_field_specs; + my @aside_field_specs; + + foreach my $f (@want_fields) { + if ($have_fields{$f}) { + push @have_fields, $f; + push @have_field_specs, $want_field_specs{$f}; + } else { + my $aside= $want_field_specs{$f}; + $aside =~ s/\bUNIQUE\b//i; + $aside =~ s/\bNOT\s*NULL\b//i; + $aside =~ s/\bPRIMARY\s*KEY\b//i; + $aside =~ s/\s+$//; + push @aside_fields, $f; + push @aside_field_specs, $aside; + push @need_recreate, "field $f"; + } + } + + #----- Do we need to recreate ? ----- + if (!@need_recreate) { + $table{$table}= $table; + return; + } + #----- Yes, recreate: ----- + + print " Recreating $table: ", join('; ',@need_recreate); + $table{$table}= "aside_$table"; + + my $have_fields= join ',', @have_fields; + my $aside_fields= join ',', @have_fields, @aside_fields; + my $have_field_specs= join ",\n", @have_field_specs; + my $aside_field_specs= join ",\n", @have_field_specs, @aside_field_specs; + + db_doall(< $table, + Sql => < $table, + Id => $cpact_idfield, + Updates => $cpact_needupdates, + Fields => [ @want_fields ], + FieldSpecs => $want_field_specs + }; +} + + +#---------- actual schema ---------- foreach my $bs (qw(buy sell)) { - db_doall(<commit; +table('dists', < commodsortkey($b); + } keys %commods; +} + +our %posincl; + { - my $insert= $dbh->prepare(<<'END') - INSERT OR IGNORE INTO commods - (unitmass, - unitvolume, - commodname) - VALUES (?,?,?); + my %classorderedcount; + + foreach my $cl (keys %commodclasses) { + $classorderedcount{$cl}= 0; + } + foreach my $commod (commods_ordered()) { + my $cl= $commods{$commod}{Class}; + die "no class for commodity $commod" unless defined $cl; + + my $clid= $commodclasses{$cl}; + die "unknown class $cl for $commod ".(join '|', sort keys %commodclasses) unless defined $clid; + + if (defined $commods{$commod}{Ordval}) { + $posincl{$commod}= ++$classorderedcount{$cl}; + } else { + $posincl{$commod}= 0; + } + } + + db_doall(<prepare(<<'END') - UPDATE commods - SET unitmass = ?, - unitvolume = ? - WHERE commodname = ? + my $addclass= $dbh->prepare(<execute($commodclasses{$cl}+1, + ucfirst $clname, + $classorderedcount{$cl}); + } +} + +{ + my @valuefields= qw( + unitmass + unitvolume + commodclassid + ordval + posinclass + ); + my $insert= $dbh->prepare(" + INSERT OR IGNORE INTO $table{commods} + ( commodname, + ".join(", + ", @valuefields)." ) + VALUES (?,".join(',', map {'?'} @valuefields).") +"); + my $update= $dbh->prepare(" + UPDATE $table{commods} + SET ".join(", + ", map { "$_ = ?" } @valuefields)." + WHERE commodname = ? +"); + foreach my $commod (commods_ordered()) { my $c= $commods{$commod}; die "no mass for $commod" unless defined $c->{Mass}; - die "no colume for $commod" unless defined $c->{Volume}; - my @qa= ($c->{Mass}, $c->{Volume}, $commod); - $insert->execute(@qa); - $update->execute(@qa); + die "no volume for $commod" unless defined $c->{Volume}; + + my $cl= $c->{Class}; + my $clid= $commodclasses{$cl}+1; + + my @valuevalues= ( + $c->{Mass}, + $c->{Volume}, + $clid, + commodsortkey($commod), + $posincl{$commod} + ); + $insert->execute($commod, @valuevalues); + $update->execute(@valuevalues, $commod); + } + + my $search= $dbh->prepare(<prepare(<commit; + my $delete= $dbh->prepare(<execute(); + my $any=0; + while (my $row= $search->fetchrow_hashref()) { + next if defined $commods{$row->{'commodname'}}; + print $any++ ? '; ' : " Dropping old commodities: ", + $row->{'commodname'}; + foreach my $bs (qw(buy sell)) { + $check{$bs}->execute($row->{'commodid'}); + my $problem= $check{$bs}->fetchrow_hashref(); + if ($problem) { + print "\n"; + die <{'commodid'} + $row->{'commodname'} + but + $bs + $problem->{'islandname'} + $problem->{'stallname'} + $problem->{'qty'} at $problem->{'price'} +END + } + } + $delete->execute($row->{'commodid'}); + } + print ".\n" if $any; } #---------- vessel types ---------- { - my $idempotent= $dbh->prepare(<<'END') - INSERT OR REPLACE INTO vessels (name, shot, mass, volume) - VALUES (?,?,?,?) + my $idempotent= $dbh->prepare(<{$_} } qw(Mass Volume)); $idempotent->execute(@qa); } - $dbh->commit; +} + +#---------- transfer data back from any recreated tables ---------- + +foreach my $tb (@need_transfer_back) { + my $tab= $tb->{Table}; + print " Retransferring $tab..."; + + if (!eval { + db_doall($tb->{Sql}); + 1; + }) { + my $emsg= $@; + my $w=20; + print STDERR "\n=== $tab retransfer failed, dumping:\n"; + my $dumph= $dbh->prepare("SELECT * FROM aside_$tab"); + $dumph->execute(); + my @cols= @{ $dumph->{NAME_lc} }; + dumptab_head(\*STDERR,$w,\@cols); + my $row; + while ($row= $dumph->fetchrow_hashref()) { + dumptab_row_hashref(\*STDERR,$w,\@cols,$row); + } + die "\n$emsg"; + } + print "\n"; + $table{$tab}= $tab; +} + +#---------- create indices ---------- + +foreach my $bs (qw(buy sell)) { + db_doall(<prepare("SELECT $minmax($f) FROM $tab"); + $sth->execute(); + my ($val)= $sth->fetchrow_array(); + return defined($val) ? $val : '?'; +} + +foreach my $cp (@need_compact) { + print " Compacting $cp->{Table}"; + my $tab= $cp->{Table}; + my $id= $cp->{Id}; + my $tmp_field_specs= $cp->{FieldSpecs}; + my $fields= join ',', @{$cp->{Fields}}; + $tmp_field_specs =~ s/\bprimary key\b/UNIQUE/i or + die "$tab $tmp_field_specs ?"; + db_doall(<1..%d:", + $cp->{Id}, + getminmax($tab,'min',$id), + $oldmax, + getminmax("idlookup_$tab",'max',"new_$id")); + my @updates= @{ $cp->{Updates} }; + while (@updates) { + my $utabs= shift @updates; + my $ufields= shift @updates; + foreach my $utab (@$utabs) { + printf(" %s",$utab); + my $fh= '.'; + foreach my $ufield (@$ufields) { + printf("%s%s",$fh,$ufield); $fh=','; + db_doall(<{AutoCommit} = 1; + $dbh->do('VACUUM'); } diff --git a/yarrg/devel-notes b/yarrg/devel-notes index f4f6066..430523a 100644 --- a/yarrg/devel-notes +++ b/yarrg/devel-notes @@ -1,21 +1,4 @@ -removing an obsolete commodity: - - select * from (select * from sell union select * from buy) left outer join commods using (commodid) where commods.commodname = 'Black dye' limit 10; - -if that produces no output then: - - begin; - delete from commods where commodname like 'Black dye'; - select * from (select * from sell union select * from buy) left outer join commods using (commodid) where commods.commodname is null limit 10; - -and if that produces no output then: - commit; -otherwise - rollback; - -======================================= - ceb's example route: alpha,byrne,papaya,turtle,jorvik,luthien diff --git a/yarrg/source-info.txt b/yarrg/source-info.txt index 846aefe..593924d 100644 --- a/yarrg/source-info.txt +++ b/yarrg/source-info.txt @@ -1,3 +1,4 @@ +# -*- fundamental -*- vessels #| Ship Name |Gun Size|Volume | Mass | @@ -31,128 +32,150 @@ shot medium 3 large 4 -commods - kraken's blood 1kg - %c dye 1kg - %c enamel 5kg - %c paint 1200g 1l +commodclasses + *basic_commodities + *ship_supplies + *herbs + *minerals + *cloth + *dye + *paint + *enamel + *forageables - %c cloth 700g - fine %c cloth 700g - sail cloth 700g +commods + kraken's blood 1kg *dye @105 + %d dye 1kg *dye @0 + %enamel enamel 5kg *enamel @0 + %c paint 1200g 1l *paint @0 + + %c cloth 700g *cloth @2 + fine %c cloth 700g *cloth @5 + sail cloth 700g *cloth @150000 + +%d + red @100 + yellow @110 + blue @120 + green @130 + lime + navy -nocommods - black dye +%enamel + %c @0 %c - aqua - black - blue - brown - gold - green - grey - lavender - lemon - light blue - light green - lime - magenta - maroon - mint - navy - orange - peach - persimmon - pink - purple - red - rose - tan - violet - white - yellow + red @100000+ + tan @100000+ + white @100000+ + black @100000+ + grey @100000+ + yellow @100000+ + pink @100000+ + violet @100000+ + purple @100000+ + navy @100000+ + blue @100000+ + aqua @100000+ + lime @100000+ + green @100000+ + orange @100000+ + aqua @100000+ + lime @100000+ + green @100000+ + orange @100000+ + maroon @100000+ + brown @100000+ + gold @100000+ + rose @100000+ + lavender @100000+ + mint @100000+ + light green @100000+ + magenta @200000+ + lemon @200000+ + peach @200000+ + light blue @200000+ + persimmon @200000+ commods - %g gems 10kg - diamonds 10kg - emeralds 10kg - moonstones 10kg - opals 10kg - pearls 10kg - rubies 10kg - sapphires 10kg - topazes 10kg + %g gems 10kg *forageables @0 + diamonds 10kg *forageables @200000+ + emeralds 10kg *forageables @200000+ + moonstones 10kg *forageables @200000+ + opals 10kg *forageables @200000+ + pearls 10kg *forageables @200000+ + rubies 10kg *forageables @200000+ + sapphires 10kg *forageables @200000+ + topazes 10kg *forageables @200000+ %g - amber - amethyst - beryl - coral - jade - jasper - jet - lapis lazuli - quartz - tigereye + amber @200000+ + amethyst @200000+ + beryl @200000+ + coral @200000+ + jade @200000+ + jasper @200000+ + jet @200000+ + lapis lazuli @200000+ + quartz @200000+ + tigereye @200000+ commods - swill 1kg - grog 1kg - fine rum 1kg - - broom flower 200g - butterfly weed 100g - cowslip 700g - elderberries 700g - indigo 700g - iris root 300g - lily of the valley 300g - lobelia 200g - madder 400g - nettle 300g - old man's beard 800g - pokeweed berries 300g - sassafras 500g - weld 300g - yarrow 200g - - bananas 125kg 100l - coconuts 125kg 100l - limes 125kg 100l - mangos 125kg 100l - pineapples 125kg 100l - - carambolas 125kg 100l - durians 125kg 100l - passion fruit 125kg 100l - pomegranates 125kg 100l - rambutan 125kg 100l - - chalcocite 5700g - cubanite 4700g - gold nuggets 400g - leushite 4400g - lorandite 5500g - masuyite 5100g - papagoite 3300g - serandite 3400g - sincosite 3000g - tellurium 6200g - thorianite 100g - - small cannon balls 7100g - medium cannon balls 14200g 2l - large cannon balls 21300g 3l - - hemp 125kg 250l - hemp oil 1kg - iron 7800g - lacquer 1kg - stone 2600g - sugar cane 50kg 100l - varnish 1kg - wood 175kg 250l + swill 1kg *ship_supplies @0+ + grog 1kg *ship_supplies @0+ + fine rum 1kg *ship_supplies @0+ + small cannon balls 7100g *ship_supplies @0+ + medium cannon balls 14200g 2l *ship_supplies @0+ + large cannon balls 21300g 3l *ship_supplies @0+ + + broom flower 200g *herbs + butterfly weed 100g *herbs + cowslip 700g *herbs + elderberries 700g *herbs + indigo 700g *herbs + iris root 300g *herbs + lily of the valley 300g *herbs + lobelia 200g *herbs + madder 400g *herbs + nettle 300g *herbs + old man's beard 800g *herbs + pokeweed berries 300g *herbs + sassafras 500g *herbs + weld 300g *herbs + yarrow 200g *herbs + + bananas 125kg 100l *forageables + coconuts 125kg 100l *forageables + limes 125kg 100l *forageables + mangos 125kg 100l *forageables + pineapples 125kg 100l *forageables + + carambolas 125kg 100l *forageables + durians 125kg 100l *forageables + passion fruit 125kg 100l *forageables + pomegranates 125kg 100l *forageables + rambutan 125kg 100l *forageables + + chalcocite 5700g *minerals + cubanite 4700g *minerals + gold nuggets 400g *minerals + leushite 4400g *minerals + lorandite 5500g *minerals + masuyite 5100g *minerals + papagoite 3300g *minerals + serandite 3400g *minerals + sincosite 3000g *minerals + tellurium 6200g *minerals + thorianite 100g *minerals + + iron 7800g *basic_commodities @110 + sugar cane 50kg 100l *basic_commodities @120 + hemp 125kg 250l *basic_commodities @130 + wood 175kg 250l *basic_commodities @140 + stone 2600g *basic_commodities @150 + hemp oil 1kg *basic_commodities @160 + varnish 1kg *basic_commodities @180 + lacquer 1kg *basic_commodities @190 client ypp-sc-tools yarrg diff --git a/yarrg/update-master-info b/yarrg/update-master-info index f757455..adad34c 100755 --- a/yarrg/update-master-info +++ b/yarrg/update-master-info @@ -95,7 +95,7 @@ sub process_some_info ($$$) { next if $h =~ m/^nocommods/; } next if $sfn =~ m/source-info/ && $h =~ m/^ocean\b/; - next if $h =~ m/^client|^vessels|^shot\b/; + next if $h =~ m/^client|^vessels|^shot\b|^commodclasses/; print $df $_, "\n" or die $!; } diff --git a/yarrg/web/docs b/yarrg/web/docs index 010fd45..2be018e 100755 --- a/yarrg/web/docs +++ b/yarrg/web/docs @@ -210,5 +210,55 @@ them for 20 PoE each, and then buy 2000 beans at B for 10 PoE each and sail them to C to sell for 20 PoE each even if such a trade would in fact be possible. In practice this is unlikely to be a problem! +

Locating commodities in the YPP client UI

+ +In the Voyage Trading Plan, YARRG indicates after the commodity name +where in the YPP commodity UI each commodity can be found. First +comes the initial letter of the category: +% my $dbh= dbw_connect('Midnight'); +% my $getclasses= $dbh->prepare( +% "SELECT commodclass FROM commodclasses ORDER BY commodclass"); +% $getclasses->execute(); +<% + join '; ', map { $_->[0] =~ m/^./ or die; "$&$'" } + @{ $getclasses->fetchall_arrayref() } +%>. +

+ +Then, if applicable, follows a number from 0 to +9 indicating roughly where the commodity is in the +list of commodities of the same class. The number indicates which +tenth of the list is: 0 for the first (top) tenth, +1 for the 2nd, and so on, up to 9 +for the final tenth. + +

+For example, +

+ +
Fine pink cloth   +
C 2
+
+
+indicates that Fine pink cloth can be found under Cloth, +between 20% and 30% of the way down through the types of Cloth. +If you mouseover that in a suitably equipped browser you should see the +text: +
+Fine pink cloth is under Cloth, commodity 14 of 55 +
+

+ +The position indicator digit isn't shown for very small +categories. + +The exact location of the commodity in the actual game +client may vary because YARRG only considers the list of all possible +commodities, not the list of actual offers at the island in question. + +Also, not all commodities are always completely categorised or +ordered; we are working to add the additional data + <& footer &> diff --git a/yarrg/web/routetrade b/yarrg/web/routetrade index 7db0772..9660094 100644 --- a/yarrg/web/routetrade +++ b/yarrg/web/routetrade @@ -140,6 +140,9 @@ my $stmt= " commods.commodid commodid, commods.unitmass unitmass, commods.unitvolume unitvolume, + commods.ordval ordval, + commods.posinclass posinclass, + commods.commodclassid commodclassid, dist dist, buy.price - sell.price unitprofit FROM commods @@ -659,14 +662,18 @@ Generated by YARRG at <% % % foreach my $i (0..$#islandids) { <% $tbody->(1) %> - + % $iquery->execute($islandids[$i]); % my ($islandname) = $iquery->fetchrow_array(); % if (!$i) { + Start at <% $islandname |h %> +[what are these codes?] + % } else { % my $this_dist= $distance->($islandids[$i-1],$islandids[$i]); % $total_dist += $this_dist; + <%perl> my $total_value= 0; foreach my $sf (@subflows) { @@ -683,7 +690,7 @@ Generated by YARRG at <% <%perl> my $age_reported= 0; my %flowlists; - #print "" if $qa->{'debug'}; + #print "" if $qa->{'debug'}; foreach my $od (qw(org dst)) { #print " [[ i $i od $od " if $qa->{'debug'}; foreach my $sf (@subflows) { @@ -697,6 +704,7 @@ Generated by YARRG at <% my $price= $f->{"${od}_price"}; my $stallname= $f->{"${od}_stallname"}; my $todo= \$flowlists{$od}{ + (sprintf "%010d", $f->{'ordval'}), $f->{'commodname'}, (sprintf "%07d", ($od eq 'dst' ? 9999999-$price : $price)), @@ -708,6 +716,33 @@ Generated by YARRG at <% dstArbitrage => 0, } unless $$todo; $$todo->{'commodname'}= $f->{'commodname'}; + $$todo->{'posinclass'}= ''; + my $incl= $f->{'posinclass'}; + + my $findclass= $dbh->prepare(<execute($f->{'commodclassid'}); + my $classinfo= $findclass->fetchrow_hashref(); + if ($classinfo) { + my $clname= $classinfo->{'commodclass'}; + my $desc= encode_entities(sprintf "%s is under %s", + $f->{'commodname'}, $clname); + my $abbrev= substr($clname,0,1); + if ($incl) { + my $maxpic= $classinfo->{'maxposinclass'}; + $desc.= (sprintf ", commodity %d of %d", + $incl, $maxpic); + if ($classinfo->{'maxposinclass'} >= 8) { + my @tmbs= qw(0 1 2 3 4 5 6 7 8 9); + my $tmbi= ($incl+0.5)*$#tmbs/$maxpic; + $abbrev.= " ".$tmbs[$tmbi]." "; + } + } + $$todo->{'posinclass'}= + "

" + .$abbrev."
"; + } $$todo->{'stallname'}= $stallname; $$todo->{Price}= $price; $$todo->{Timestamp}= $f->{"${od}_timestamp"}; @@ -739,7 +774,7 @@ Generated by YARRG at <% -<% $xinfo %> +<% $xinfo %> <% $totaldesc %> <% $totalwas |h %> total <%perl> @@ -770,6 +805,7 @@ Generated by YARRG at <% % tr_datarow($m,$dline); <<% $td %>><% $collectdeliver %> <<% $td %>><% $t->{'commodname'} |h %> +<<% $td %>><% $t->{'posinclass'} %> % % my @stalls= sort keys %{ $t->{Stalls} }; % my $pstall= sub { @@ -816,7 +852,7 @@ Generated by YARRG at <% } <% $tbody->(1) %> -Total distance: <% $total_dist %> leagues. +Total distance: <% $total_dist %> leagues. Overall net cash flow <% $total_total < 0 ? -$total_total." loss" : $total_total." gain" diff --git a/yarrg/web/style.css b/yarrg/web/style.css index 858dcb9..1d52168 100755 --- a/yarrg/web/style.css +++ b/yarrg/web/style.css @@ -47,4 +47,5 @@ $r->content_type('text/css') padding-left: 1em; padding-top: 0.15em; padding-right: 1em; padding-bottom: 0.15em; } + div.mouseover { color: blue; } hr { display: none; } diff --git a/yarrg/yppedia-chart-parser b/yarrg/yppedia-chart-parser index 41ef985..e6e22b5 100755 --- a/yarrg/yppedia-chart-parser +++ b/yarrg/yppedia-chart-parser @@ -772,6 +772,7 @@ for (;;) { print STDERR "*** --stdin-chart, aborting!\n"; exit 1; } + progress("checking database"); db_check_referential_integrity(); progress("committing database"); $dbh->commit(); progress("committing _ocean-*.txt"); localtopo_commit(); exit 0;