X-Git-Url: http://www.chiark.greenend.org.uk/ucgi/~yarrgweb/git?a=blobdiff_plain;f=yarrg%2Fweb%2Fquery_routesearch;h=34fbc22e38d25584a078afd1caf05b78ed1b7497;hb=767fa1cf87952a46530bfaa2de0543ac07b64c2a;hp=53128f6483d255723b1ec4df69b2617dbde54387;hpb=5df1a21a8f7ad18ade3a97b9ccf26bdcf335edd2;p=ypp-sc-tools.db-test.git diff --git a/yarrg/web/query_routesearch b/yarrg/web/query_routesearch index 53128f6..34fbc22 100644 --- a/yarrg/web/query_routesearch +++ b/yarrg/web/query_routesearch @@ -36,20 +36,27 @@ <%args> $quri $dbh +$islandstring => ''; $capacitystring => ''; $lossperleague => ''; $capitalstring => ''; +$distance => ''; +$someresults $emsgokorprint %args> <%perl> +use BSD::Resource; + my $emsg; my @warningfs; my @islandids; my $qa= \%ARGS; -my $routeparams= { EmsgRef => \$emsg }; +my $routeparams= { EmsgRef => \$emsg, SayRequiredCapacity => 1 }; my $maxdist; +my $maxcountea=10; + %perl>
+<%perl> +} + +unshift @rsargs, sourcebasedir().'/yarrg/routesearch'; + +my %results; # $results{$ap}{"5 6 9 10"} = { stuff } + +my $fh= new IO::File; +my $child= $fh->open("-|"); defined $child or die $!; +if (!$child) { + my $cpu= BSD::Resource::RLIMIT_CPU; + my ($soft,$hard)= getrlimit($cpu); + my $max=10; + setrlimit($cpu,$max,$hard) or die $! if $soft>$max; + exec @rsargs; + die $!; +} + +while (<$fh>) { + chomp; + if ($qa->{'debug'}) { +%perl> +<% $_ |h %> +<%perl> + } + next unless + m/^ \@ *\d+ ([ap])\# *\d+ \|.*\| *\d+ +(\d+) +(\d+) *\| ([0-9 ]+)$/; + my ($ap,$isles) = (uc $1,$4); + next if $results{$ap} && %{$results{$ap}} >= $maxcountea; + my $item= { A => $2, P => $3 }; + my (@i, @a); + foreach (split / /, $isles) { + my ($name,$arch)= $isleinfo->($_); + push @i, $name; + push @a, $arch unless @a && $a[-1] eq $arch; + } + $item->{Isles}= [ @i ]; + $item->{Archs}= [ @a ]; + $item->{Start}= $i[0]; + $item->{Finish}= $i[-1]; + $item->{Vias}= [ ]; + my $i; + for ($i=1; $i < @i-1; $i++) { + push @{ $item->{Vias} }, $i[$i]; + } + $results{$ap}{$isles}= $item; +} + +if ($qa->{'debug'}) { + print "\n"; +} + +%perl> +% foreach my $ap (qw(A P)) { +
Profit + | Archipelagoes + | Route + | |||
---|---|---|---|---|---|
Abs. + | Per.lg. + | + | Start + | Via + | Finish + |
<% $item->{A} |h %> + | <% $item->{P} |h %> + | <% join ', ', @{ $item->{Archs} } |h %> + | <% $item->{Start} |h %>, + | <% join ' ', map { $_.',' } @{ $item->{Vias} } |h %> + | <% $item->{Finish} |h %> + | +% $datarow ^= 1; +% } # $isles +