@ISA = qw(Exporter);
@EXPORT = qw(&dbw_connect &dbw_filename &ocean_list &sourcebasedir
&to_json_shim &to_json_protecttags
- &set_ctype_utf8
+ &set_ctype_utf8 &webdatadir
&expected_error &dbw_lookup_string
&prettyprint_age &meta_prettyprint_age);
%EXPORT_TAGS = ( );
return dotperllibdir().'/..';
}
-sub datadir () {
- my $edir= $ENV{'YARRG_DATA_DIR'};
+sub some_datadir ($) {
+ my ($what) = @_;
+ my $edir= $ENV{"YARRG_${what}_DIR"};
return $edir if defined $edir;
my $dir= dotperllibdir();
- if (stat "$dir/DATA") {
- return "$dir/DATA";
+ my $dirwhat= "$dir/$what";
+ if (stat $dirwhat) {
+ return $dirwhat;
} elsif ($!==&ENOENT) {
return "$dir";
} else {
- die "stat $dir/DATA $!";
+ die "stat $dirwhat $!";
}
return '.';
}
+sub webdatadir () { return some_datadir('WEBDATA'); }
+sub datadir () { return some_datadir('DATA'); }
+
my @ocean_list;
sub ocean_list () {
-routesearch:
-
- concurrency limit option
-
query_routesearch:
Doesn't spot routesearch dying
links to per-route pages
- concurrency limit
nice routesearch
sort arrows on table
int i, ap;
int granui;
const char *database=0;
+ const char *concur_base=0, *concur_rhs=0;
+ int concur_lim=-1;
#ifndef debug_flags
debug_flags= ~( dbg_sql2 );
if (arg[0] != '-') break;
if (!strcmp(arg,"-d")) {
database= *++argv;
+ } else if (!strcmp(arg,"-C")) {
+ concur_base= *++argv;
+ concur_rhs= *++argv;
+ concur_lim= atoi(*++argv);
} else if (!strcmp(arg,"-g")) {
granus= atoi(*++argv);
assert(granus>=1 && granus<=GRANUS);
min_trade_maxprofit= atoi(*argv++);
+ if (concur_base) {
+ for (i=0; i<concur_lim; i++) {
+ char *concfn= masprintf("%s%02d%s", concur_base, i, concur_rhs);
+ int concfd, r;
+ sysassert( (concfd= open(concfn, O_RDWR|O_CREAT|O_TRUNC, 0600)) >= 0);
+ struct flock fl;
+ memset(&fl,0,sizeof(fl));
+ fl.l_type= F_WRLCK;
+ r= fcntl(concfd, F_SETLK, &fl);
+ free(concfn);
+ if (!r) goto concur_ok;
+ sysassert( errno == EWOULDBLOCK );
+ close(concfd);
+ }
+ fprintf(output,"@@@ concurrency limit exceeded (%d)\n", concur_lim);
+ exit(0);
+
+ concur_ok:
+ /* deliberately leak concfd */
+ fprintf(output,"concurrency slot %d\n", i);
+ }
+
setup_sql(database);
setup_value();
setup_search();
my $maxmaxdist=35;
my $maxcpu=90;
+my $concur_lim=5;
my $qa= \%ARGS;
my $routeparams= { EmsgRef => \$emsg, SayRequiredCapacity => 1 };
#---------- compute the results ----------
-my @rsargs= qw(-DN);
+my @rsargs= ($concur_lim, '-DN');
+my $concur_fail;
foreach my $k (qw(MaxMass MaxVolume MaxCapital)) {
my $v= $routeparams->{$k};
<%perl>
}
-unshift @rsargs, sourcebasedir().'/yarrg/routesearch',
- '-d', dbw_filename($qa->{'Ocean'});
+unshift @rsargs,
+ sourcebasedir().'/yarrg/routesearch',
+ '-d', dbw_filename($qa->{'Ocean'}),
+ '-C', webdatadir().'/_concur.', '.lock';
+
+# touch _concur.0{0,1,2,3,4}.lock
+# really chgrp www-data _concur.0?.lock
my %results; # $results{$ap}{"5 6 9 10"} = { stuff }
<% $_ |h %>
<%perl>
}
- next unless m/^ \@ *\d+ ([ap])\# *\d+ \|.*\| *(\d+)lg *\| *\d+ +(\d+) +(\d+) *\| ([0-9 ]+)$/;
+ next unless m/^\s*\@/;
+ if (m/^\@\@\@ concurrency limit exceeded/) {
+ $concur_fail= 1;
+ last;
+ }
+ die unless m/^ \@ *\d+ ([ap])\# *\d+ \|.*\| *(\d+)lg *\| *\d+ +(\d+) +(\d+) *\| ([0-9 ]+)$/;
my ($ap,$isles) = (uc $1,$5);
next if $results{$ap} && %{$results{$ap}} >= $maxcountea;
my $item= { A => $3, P => $4, Leagues => $2 };
print "</pre>\n";
}
+if ($concur_fail) {
+</%perl>
+<h2>Server too busy</h2>
+
+Sorry, but there are already <% $concur_lim |h %> route searches
+running. We limit the number which can run at once to avoid
+overloading the server system and to make sure that the rest of the
+YARRG website still runs quickly.
+<p>
+
+If you submitted several searches and gave up on them (eg by hitting
+`back' or `stop' in your browser), be aware that that doesn't
+generally stop the search process at the server end. So it's best to
+avoid asking for large searches that you're not sure about.
+
+<p>
+Otherwise, please try later. Searches are limited to <% $maxcpu |h %>
+seconds of CPU time so more processing resources should be available soon.
+
+<%perl>
+ return;
+}
+
</%perl>
% foreach my $ap (qw(A P)) {
<h2>ap=<% $ap %></h2>
<table rules=groups>
<colgroup span=2>
<colgroup span=1>
+<colgroup span=1>
<colgroup span=3>
<tbody>
<tr>