Open-ILS/src/perlmods/lib/OpenILS/Application/URLVerify.pm

   1 package OpenILS::Application::URLVerify;
   2
   3 # For code searchability, I'm telling you this is the "link checker."
   4
   5 use base qw/OpenILS::Application/;
   6 use strict; use warnings;
   7 use OpenSRF::Utils::Logger qw(:logger);
   8 use OpenSRF::MultiSession;
   9 use OpenSRF::Utils::SettingsClient;
  10 use OpenILS::Utils::Fieldmapper;
  11 use OpenILS::Utils::CStoreEditor q/:funcs/;
  12 use OpenILS::Application::AppUtils;
  13 use LWP::UserAgent;
  14
  15 use Data::Dumper;
  16
  17 $Data::Dumper::Indent = 0;
  18
  19 my $U = 'OpenILS::Application::AppUtils';
  20
  21 my $user_agent_string;
  22
  23 sub initialize {
  24     my $conf = new OpenSRF::Utils::SettingsClient;
  25
  26     my @confpath = qw/apps open-ils.url_verify app_settings user_agent/;
  27
  28     $user_agent_string =
  29         sprintf($conf->config_value(@confpath), __PACKAGE__->ils_version);
  30
  31     $logger->info("using '$user_agent_string' as User Agent string");
  32 }
  33
  34 __PACKAGE__->register_method(
  35     method => 'verify_session',
  36     api_name => 'open-ils.url_verify.session.verify',
  37     stream => 1,
  38     max_chunk_size => 0,
  39     signature => {
  40         desc => q/
  41             Performs verification on all (or a subset of the) URLs within the requested session.
  42         /,
  43         params => [
  44             {desc => 'Authentication token', type => 'string'},
  45             {desc => 'Session ID (url_verify.session.id)', type => 'number'},
  46             {desc => 'URL ID list (optional).  An empty list will result in no URLs being processed, but null will result in all the URLs for the session being processed', type => 'array'},
  47             {
  48                 desc => q/
  49                     Options (optional).
  50                         report_all => bypass response throttling and return all URL sub-process
  51                             responses to the caller.  Not recommened for remote (web, etc.) clients,
  52                             because it can be a lot of data.
  53                         resume_attempt => atttempt_id.  Resume verification after a failure.
  54                         resume_with_new_attempt => If true, resume from resume_attempt, but
  55                             create a new attempt to track the resumption.
  56                     /,
  57                 type => 'hash'
  58             }
  59         ],
  60         return => {desc => q/
  61             Stream of objects containing the number of URLs to be processed (url_count),
  62             the number processed thus far including redirects (total_processed),
  63             and the current url_verification object (current_verification).
  64
  65             Note that total_processed may ultimately exceed url_count, since it
  66             includes non-anticipate-able redirects.
  67
  68             The final response contains url_count, total_processed, and the
  69             verification_attempt object (attempt).
  70             /
  71         }
  72     }
  73 );
  74
  75 # "verify_session" sounds like something to do with authentication, but it
  76 # actually means for a given session, verify all the URLs associated with
  77 # that session.
  78 sub verify_session {
  79     my ($self, $client, $auth, $session_id, $url_ids, $options) = @_;
  80     $options ||= {};
  81
  82     my $e = new_editor(authtoken => $auth, xact => 1);
  83     return $e->die_event unless $e->checkauth;
  84     return $e->die_event unless $e->allowed('URL_VERIFY');
  85
  86     my $session = $e->retrieve_url_verify_session($session_id)
  87         or return $e->die_event;
  88
  89     my $attempt_id = $options->{resume_attempt};
  90
  91     if (!$url_ids) {
  92
  93         # No URLs provided, load all URLs for the requested session
  94
  95         my $query = {
  96             select => {uvu => ['id']},
  97             from => {
  98                 uvu => { # url
  99                     uvs => { # session
 100                         filter => {id => $session_id}
 101                     }
 102                 }
 103             }
 104         };
 105
 106         if ($attempt_id) {
 107
 108             # when resuming an existing attempt (that presumably failed
 109             # mid-processing), we only want to process URLs that either
 110             # have no linked url_verification or have an un-completed
 111             # url_verification.
 112
 113             $logger->info("url: resuming attempt $attempt_id");
 114
 115             $query->{from}->{uvu}->{uvuv} = {
 116                 type => 'left',
 117                 filter => {attempt => $attempt_id}
 118             };
 119
 120             $query->{where} = {
 121                 '+uvuv' => {
 122                     '-or' => [
 123                         {id => undef}, # no verification started
 124                         {res_code => undef} # verification started but did no complete
 125                     ]
 126                 }
 127             };
 128
 129         } else {
 130
 131             # this is a new attempt, so we only want to process URLs that
 132             # originated from the source records and not from redirects.
 133
 134             $query->{where} = {
 135                 '+uvu' => {redirect_from => undef}
 136             };
 137         }
 138
 139         my $ids = $e->json_query($query);
 140         $url_ids = [ map {$_->{id}} @$ids ];
 141     }
 142
 143     my $url_count = scalar(@$url_ids);
 144     $logger->info("url: processing $url_count URLs");
 145
 146     my $attempt;
 147     if ($attempt_id and !$options->{resume_with_new_attempt}) {
 148
 149         $attempt = $e->retrieve_url_verification_attempt($attempt_id)
 150             or return $e->die_event;
 151
 152         # no data was written
 153         $e->rollback;
 154
 155     } else {
 156
 157         $attempt = Fieldmapper::url_verify::verification_attempt->new;
 158         $attempt->session($session_id);
 159         $attempt->usr($e->requestor->id);
 160         $attempt->start_time('now');
 161
 162         $e->create_url_verify_verification_attempt($attempt)
 163             or return $e->die_event;
 164
 165         $attempt = $e->data;
 166         $e->commit;
 167     }
 168
 169     # END DB TRANSACTION
 170
 171     # Now cycle through the URLs in batches.
 172
 173     my $batch_size = $U->ou_ancestor_setting_value(
 174         $session->owning_lib,
 175         'url_verify.verification_batch_size', $e) || 5;
 176
 177     my $total_excluding_redirects = 0;
 178     my $total_processed = 0; # total number processed, including redirects
 179     my $resp_window = 1;
 180
 181     # before we start the real work, let the caller know
 182     # the attempt (id) so recovery is possible.
 183
 184     $client->respond({
 185         url_count => $url_count,
 186         total_processed => $total_processed,
 187         total_excluding_redirects => $total_excluding_redirects,
 188         attempt => $attempt
 189     });
 190
 191     my $multises = OpenSRF::MultiSession->new(
 192
 193         app => 'open-ils.url_verify', # hey, that's us!
 194         cap => $batch_size,
 195
 196         success_handler => sub {
 197             my ($self, $req) = @_;
 198
 199             # API call streams fleshed url_verification objects.  We wrap
 200             # those up with some extra info and pass them on to the caller.
 201
 202             for my $resp (@{$req->{response}}) {
 203                 my $content = $resp->content;
 204
 205                 if ($content) {
 206
 207                     $total_processed++;
 208
 209                     if ($options->{report_all} or ($total_processed % $resp_window == 0)) {
 210
 211                         $client->respond({
 212                             url_count => $url_count,
 213                             current_verification => $content,
 214                             total_excluding_redirects => $total_excluding_redirects,
 215                             total_processed => $total_processed
 216                         });
 217
 218                         # start off responding quickly, then throttle
 219                         # back to only relaying every 256 messages.
 220                         $resp_window *= 2 unless $resp_window >= 256;
 221                     }
 222                 }
 223             }
 224         },
 225
 226         failure_handler => sub {
 227             my ($self, $req) = @_;
 228
 229             # {error} should be an Error w/ a toString
 230             $logger->error("url: error processing URL: " . $req->{error});
 231         }
 232     );
 233
 234     sort_and_fire_domains(
 235         $e, $auth, $attempt, $url_ids, $multises, \$total_excluding_redirects
 236     );
 237
 238     # Wait for all requests to be completed
 239     $multises->session_wait(1);
 240
 241     # All done.  Let's wrap up the attempt.
 242     $attempt->finish_time('now');
 243
 244     $e->xact_begin;
 245     $e->update_url_verify_verification_attempt($attempt) or
 246         return $e->die_event;
 247
 248     $e->xact_commit;
 249
 250     # This way the caller gets an actual timestamp in the "finish_time" field
 251     # instead of the string "now".
 252     $attempt = $e->retrieve_url_verify_verification_attempt($e->data) or
 253         return $e->die_event;
 254
 255     $e->disconnect;
 256
 257     return {
 258         url_count => $url_count,
 259         total_processed => $total_processed,
 260         total_excluding_redirects => $total_excluding_redirects,
 261         attempt => $attempt
 262     };
 263 }
 264
 265 # retrieves the URL domains and sorts them into buckets*
 266 # Iterates over the buckets and fires the multi-session call
 267 # the main drawback to this domain sorting approach is that
 268 # any domain used a lot more than the others will be the
 269 # only domain standing after the others are exhausted, which
 270 # means it will take a beating at the end of the batch.
 271 #
 272 # * local data structures, not container.* buckets
 273 sub sort_and_fire_domains {
 274     my ($e, $auth, $attempt, $url_ids, $multises, $count) = @_;
 275
 276     # there is potential here for data sets to be too large
 277     # for delivery, but it's not likely, since we're only
 278     # fetching ID and domain.
 279     my $urls = $e->json_query(
 280         {
 281             select => {uvu => ['id', 'domain']},
 282             from => 'uvu',
 283             where => {id => $url_ids}
 284         },
 285         # {substream => 1} only if needed
 286     );
 287
 288     # sort them into buckets based on domain name
 289     my %domains;
 290     for my $url (@$urls) {
 291         $domains{$url->{domain}} = [] unless $domains{$url->{domain}};
 292         push(@{$domains{$url->{domain}}}, $url->{id});
 293     }
 294
 295     # loop through the domains and fire the verification call
 296     while (keys %domains) {
 297         for my $domain (keys %domains) {
 298
 299             my $url_id = pop(@{$domains{$domain}});
 300             delete $domains{$domain} unless @{$domains{$domain}};
 301
 302             $multises->request(
 303                 'open-ils.url_verify.verify_url',
 304                 $auth, $attempt->id, $url_id);
 305
 306             $$count++;  # sic, a reference to a scalar
 307         }
 308     }
 309 }
 310
 311
 312 # XXX I really want to move this method to open-ils.storage, so we don't have
 313 # to authenticate a zillion times. LFW
 314
 315 __PACKAGE__->register_method(
 316     method => 'verify_url',
 317     api_name => 'open-ils.url_verify.verify_url',
 318     stream => 1,
 319     signature => {
 320         desc => q/
 321             Performs verification of a single URL.  When a redirect is detected,
 322             a new URL is created to model the redirect and the redirected URL
 323             is then tested, up to max-redirects or a loop is detected.
 324         /,
 325         params => [
 326             {desc => 'Authentication token', type => 'string'},
 327             {desc => 'Verification attempt ID (url_verify.verification_attempt.id)', type => 'number'},
 328             {desc => 'URL id (url_verify.url.id)', type => 'number'},
 329         ],
 330         return => {desc => q/Stream of url_verification objects, one per URL tested/}
 331     }
 332 );
 333
 334 =head comment
 335
 336 verification.res_code:
 337
 338 999 bad hostname, etc. (IO::Socket::Inet errors)
 339 998 in-flight errors (e.g connection closed prematurely)
 340 997 timeout
 341 996 redirect loop
 342 995 max redirects
 343
 344 verification.res_text:
 345
 346 $@ or custom message "Redirect Loop"
 347
 348 =cut
 349
 350 sub verify_url {
 351     my ($self, $client, $auth, $attempt_id, $url_id) = @_;
 352     my %seen_urls;
 353
 354     my $e = new_editor(authtoken => $auth);
 355     return $e->event unless $e->checkauth;
 356
 357     my $url = $e->retrieve_url_verify_url($url_id) or return $e->event;
 358
 359     my ($attempt, $delay, $max_redirects, $timeout) =
 360         collect_verify_attempt_and_settings($e, $attempt_id);
 361
 362     return $e->event unless $e->allowed(
 363         'URL_VERIFY', $attempt->session->owning_lib);
 364
 365     my $cur_url = $url;
 366     my $loop_detected = 0;
 367     my $redir_count = 0;
 368
 369     while ($redir_count++ < $max_redirects) {
 370
 371         if ($seen_urls{$cur_url->full_url}) {
 372             $loop_detected = 1;
 373             last;
 374         }
 375
 376         $seen_urls{$cur_url->full_url} = $cur_url;
 377
 378         my $url_resp = verify_one_url($e, $attempt, $cur_url, $timeout);
 379
 380         # something tragic happened
 381         return $url_resp if $U->is_event($url_resp);
 382
 383         # flesh and respond to the caller
 384         $url_resp->{verification}->url($cur_url);
 385         $client->respond($url_resp->{verification});
 386
 387         $cur_url = $url_resp->{redirect_url} or last;
 388     }
 389
 390     if ($loop_detected or $redir_count > $max_redirects) {
 391
 392         my $vcation = Fieldmapper::url_verify::url_verification->new;
 393         $vcation->url($cur_url->id);
 394         $vcation->attempt($attempt->id);
 395         $vcation->req_time('now');
 396
 397         if ($loop_detected) {
 398             $logger->info("url: redirect loop detected at " . $cur_url->full_url);
 399             $vcation->res_code('996');
 400             $vcation->res_text('Redirect Loop');
 401
 402         } else {
 403             $logger->info("url: max redirects reached for source URL " . $url->full_url);
 404             $vcation->res_code('995');
 405             $vcation->res_text('Max Redirects');
 406         }
 407
 408         $e->xact_begin;
 409         $e->create_url_verify_url_verification($vcation) or return $e->die_event;
 410         $e->xact_commit;
 411     }
 412
 413     # The calling code is likely not multi-threaded, so a
 414     # per-URL (i.e. per-thread) delay would not be possible.
 415     # Applying the delay here allows the caller to process
 416     # batches of URLs without having to worry about the delay.
 417     sleep $delay;
 418
 419     return undef;
 420 }
 421
 422 # temporarily cache some data to avoid a pile
 423 # of data lookups on every URL processed.
 424 my %cache;
 425 sub collect_verify_attempt_and_settings {
 426     my ($e, $attempt_id) = @_;
 427     my $attempt;
 428
 429     if (!(keys %cache) or $cache{age} > 20) { # configurable?
 430         %cache = (
 431             age => 0,
 432             attempt => {},
 433             delay => {},
 434             redirects => {},
 435             timeout => {},
 436         );
 437     }
 438
 439     if ( !($attempt = $cache{attempt}{$attempt_id}) ) {
 440
 441         # attempt may have just been created, so
 442         # we need to guarantee a write-DB read.
 443         $e->xact_begin;
 444
 445         $attempt =
 446             $e->retrieve_url_verify_verification_attempt([
 447                 $attempt_id, {
 448                     flesh => 1,
 449                     flesh_fields => {uvva => ['session']}
 450                 }
 451             ]) or return $e->die_event;
 452
 453         $e->rollback;
 454
 455         $cache{attempt}{$attempt_id} = $attempt;
 456     }
 457
 458     my $org = $attempt->session->owning_lib;
 459
 460     if (!$cache{timeout}{$org}) {
 461
 462         $cache{delay}{$org} = $U->ou_ancestor_setting_value(
 463             $org, 'url_verify.url_verification_delay', $e);
 464
 465         # 0 is a valid delay
 466         $cache{delay}{$org} = 2 unless defined $cache{delay}{$org};
 467
 468         $cache{redirects}{$org} = $U->ou_ancestor_setting_value(
 469             $org, 'url_verify.url_verification_max_redirects', $e) || 20;
 470
 471         $cache{timeout}{$org} = $U->ou_ancestor_setting_value(
 472             $org, 'url_verify.url_verification_max_wait', $e) || 5;
 473
 474         $logger->info(
 475             sprintf("url: loaded settings delay=%s; max_redirects=%s; timeout=%s",
 476                 $cache{delay}{$org}, $cache{redirects}{$org}, $cache{timeout}{$org}));
 477     }
 478
 479     $cache{age}++;
 480
 481
 482     return (
 483         $cache{attempt}{$attempt_id},
 484         $cache{delay}{$org},
 485         $cache{redirects}{$org},
 486         $cache{timeout}{$org}
 487     );
 488 }
 489
 490
 491 # searches for a completed url_verfication for any url processed
 492 # within this verification attempt whose full_url matches the
 493 # full_url of the provided URL.
 494 sub find_matching_url_for_attempt {
 495     my ($e, $attempt, $url) = @_;
 496
 497     my $match = $e->json_query({
 498         select => {uvuv => ['id']},
 499         from => {
 500             uvuv => {
 501                 uvva => { # attempt
 502                     filter => {id => $attempt->id}
 503                 },
 504                 uvu => {} # url
 505             }
 506         },
 507         where => {
 508             '+uvu' => {
 509                 id => {'!=' => $url->id},
 510                 full_url => $url->full_url
 511             },
 512
 513             # There could be multiple verifications for matching URLs
 514             # We only want a verification that completed.
 515             # Note also that 2 identical URLs processed within the same
 516             # sub-batch will have to each be fully processed in their own
 517             # right, since neither knows how the other will ultimately fare.
 518             '+uvuv' => {
 519                 res_time => {'!=' => undef}
 520             }
 521         }
 522     })->[0];
 523
 524     return $e->retrieve_url_verify_url_verification($match->{id}) if $match;
 525     return undef;
 526 }
 527
 528
 529 =head comment
 530
 531 1. create the verification object and commit.
 532 2. test the URL
 533 3. update the verification object to capture the results of the test
 534 4. Return redirect_url object if this is a redirect, otherwise undef.
 535
 536 =cut
 537
 538 sub verify_one_url {
 539     my ($e, $attempt, $url, $timeout) = @_;
 540
 541     my $url_text = $url->full_url;
 542     my $redir_url;
 543
 544     # first, create the verification object so we can a) indicate that
 545     # we're working on this URL and b) get the DB to set the req_time.
 546
 547     my $vcation = Fieldmapper::url_verify::url_verification->new;
 548     $vcation->url($url->id);
 549     $vcation->attempt($attempt->id);
 550     $vcation->req_time('now');
 551
 552     # begin phase-I DB communication
 553
 554     $e->xact_begin;
 555
 556     my $match_vcation = find_matching_url_for_attempt($e, $attempt, $url);
 557
 558     if ($match_vcation) {
 559         $logger->info("url: found matching URL in verification attempt [$url_text]");
 560         $vcation->res_code($match_vcation->res_code);
 561         $vcation->res_text($match_vcation->res_text);
 562         $vcation->redirect_to($match_vcation->redirect_to);
 563     }
 564
 565     $e->create_url_verify_url_verification($vcation) or return $e->die_event;
 566     $e->xact_commit;
 567
 568     # found a matching URL, no need to re-process
 569     return {verification => $vcation} if $match_vcation;
 570
 571     # End phase-I DB communication
 572     # No active DB xact means no cstore timeout concerns.
 573
 574     # Now test the URL.
 575
 576     $ENV{FTP_PASSIVE} = 1; # TODO: setting?
 577
 578     my $ua = LWP::UserAgent->new(
 579         ssl_opts => {verify_hostname => 0}, # TODO: verify_hostname setting?
 580         agent => $user_agent_string
 581     );
 582
 583     $ua->timeout($timeout);
 584
 585     my $req = HTTP::Request->new(HEAD => $url->full_url);
 586
 587     # simple_request avoids LWP's auto-redirect magic
 588     my $res = $ua->simple_request($req);
 589
 590     $logger->info(sprintf(
 591         "url: received HTTP '%s' / '%s' [%s]",
 592         $res->code,
 593         $res->message,
 594         $url_text
 595     ));
 596
 597     $vcation->res_code($res->code);
 598     $vcation->res_text($res->message);
 599
 600     # is this a redirect?
 601     if ($res->code =~ /^3/) {
 602
 603         if (my $loc = $res->headers->{location}) {
 604             $redir_url = Fieldmapper::url_verify::url->new;
 605             $redir_url->session($attempt->session);
 606             $redir_url->redirect_from($url->id);
 607             $redir_url->full_url($loc);
 608
 609             $logger->info("url: redirect found $url_text => $loc");
 610
 611         } else {
 612             $logger->info("url: server returned 3XX but no 'Location' header for url $url_text");
 613         }
 614     }
 615
 616     # Begin phase-II DB communication
 617
 618     $e->xact_begin;
 619
 620     if ($redir_url) {
 621         $redir_url = $e->create_url_verify_url($redir_url) or return $e->die_event;
 622         $vcation->redirect_to($redir_url->id);
 623     }
 624
 625     $vcation->res_time('now');
 626     $e->update_url_verify_url_verification($vcation) or return $e->die_event;
 627     $e->commit;
 628
 629     return {
 630         verification => $vcation,
 631         redirect_url => $redir_url
 632     };
 633 }
 634
 635
 636 __PACKAGE__->register_method(
 637     method => "create_session",
 638     api_name => "open-ils.url_verify.session.create",
 639     signature => {
 640         desc => q/Create a URL verify session. Also automatically create and
 641             link a container./,
 642         params => [
 643             {desc => "Authentication token", type => "string"},
 644             {desc => "session name", type => "string"},
 645             {desc => "QueryParser search", type => "string"},
 646             {desc => "owning_lib (defaults to ws_ou)", type => "number"},
 647         ],
 648         return => {desc => "ID of new session or event on error", type => "number"}
 649     }
 650 );
 651
 652 sub create_session {
 653     my ($self, $client, $auth, $name, $search, $owning_lib) = @_;
 654
 655     my $e = new_editor(authtoken => $auth, xact => 1);
 656     return $e->die_event unless $e->checkauth;
 657
 658     $owning_lib ||= $e->requestor->ws_ou;
 659     return $e->die_event unless $e->allowed("URL_VERIFY", $owning_lib);
 660
 661     $name .= "";
 662     my $name_test = $e->search_url_verify_session({name => $name});
 663     return $e->die_event unless $name_test; # db error
 664     return $e->die_event(
 665         new OpenILS::Event("OBJECT_UNIQUE_IDENTIFIER_USED", note => "name"),
 666     ) if @$name_test;   # already existing sessions with that name
 667
 668     my $session = Fieldmapper::url_verify::session->new;
 669     $session->name($name);
 670     $session->owning_lib($owning_lib);
 671     $session->creator($e->requestor->id);
 672     $session->search($search);
 673
 674     my $container = Fieldmapper::container::biblio_record_entry_bucket->new;
 675     $container->btype("url_verify");
 676     $container->owner($e->requestor->id);
 677     $container->name($name);
 678     $container->description("Automatically generated");
 679
 680     $e->create_container_biblio_record_entry_bucket($container) or
 681         return $e->die_event;
 682
 683     $session->container($e->data->id);
 684     $e->create_url_verify_session($session) or
 685         return $e->die_event;
 686
 687     $e->commit or return $e->die_event;
 688
 689     return $e->data->id;
 690 }
 691
 692 # _check_for_existing_bucket_items() is used later by session_search_and_extract()
 693 sub _check_for_existing_bucket_items {
 694     my ($e, $session) = @_;
 695
 696     my $items = $e->json_query(
 697         {
 698             select => {cbrebi => ['id']},
 699             from => {cbrebi => {}},
 700             where => {bucket => $session->container},
 701             limit => 1
 702         }
 703     ) or return $e->die_event;
 704
 705     return new OpenILS::Event("URL_VERIFY_SESSION_ALREADY_SEARCHED") if @$items;
 706
 707     return;
 708 }
 709
 710 # _get_all_search_results() is used later by session_search_and_extract()
 711 sub _get_all_search_results {
 712     my ($client, $session) = @_;
 713
 714     my @result_ids;
 715
 716     # Don't loop if the user has specified their own offset.
 717     if ($session->search =~ /offset\(\d+\)/) {
 718         my $res = $U->simplereq(
 719             "open-ils.search",
 720             "open-ils.search.biblio.multiclass.query.staff",
 721             {}, $session->search
 722         );
 723
 724         return new OpenILS::Event("UNKNOWN") unless $res;
 725         return $res if $U->is_event($res);
 726
 727         @result_ids = map { shift @$_ } @{$res->{ids}}; # IDs nested in array
 728     } else {
 729         my $count;
 730         my $so_far = 0;
 731
 732         LOOP: { do {    # Fun fact: you cannot "last" out of a do/while in Perl
 733                         # unless you wrap it another loop structure.
 734             my $search = $session->search . " offset(".scalar(@result_ids).")";
 735
 736             my $res = $U->simplereq(
 737                 "open-ils.search",
 738                 "open-ils.search.biblio.multiclass.query.staff",
 739                 {}, $search
 740             );
 741
 742             return new OpenILS::Event("UNKNOWN") unless $res;
 743             return $res if $U->is_event($res);
 744
 745             # Search only returns the total count when offset is 0.
 746             # We can't get more than one superpage this way, XXX TODO ?
 747             $count = $res->{count} unless defined $count;
 748
 749             my @this_batch = map { shift @$_ } @{$res->{ids}}; # unnest IDs
 750             push @result_ids, @this_batch;
 751
 752             # Send a keepalive in case search is slow, although it'll probably
 753             # be the query for the first ten results that's slowest.
 754             $client->status(new OpenSRF::DomainObject::oilsContinueStatus);
 755
 756             last unless @this_batch; # Protect against getting fewer results
 757                                      # than count promised.
 758
 759         } while ($count - scalar(@result_ids) > 0); }
 760     }
 761
 762     return (undef, @result_ids);
 763 }
 764
 765
 766 __PACKAGE__->register_method(
 767     method => "session_search_and_extract",
 768     api_name => "open-ils.url_verify.session.search_and_extract",
 769     stream => 1,
 770     signature => {
 771         desc => q/
 772             Perform the search contained in the session,
 773             populating the linked bucket, and extracting URLs /,
 774         params => [
 775             {desc => "Authentication token", type => "string"},
 776             {desc => "url_verify.session id", type => "number"},
 777         ],
 778         return => {
 779             desc => q/stream of numbers: first number of search results, then
 780                 numbers of extracted URLs for each record, grouped into arrays
 781                 of 100/,
 782             type => "number"
 783         }
 784     }
 785 );
 786
 787 sub session_search_and_extract {
 788     my ($self, $client, $auth, $ses_id) = @_;
 789
 790     my $e = new_editor(authtoken => $auth);
 791     return $e->die_event unless $e->checkauth;
 792
 793     my $session = $e->retrieve_url_verify_session(int($ses_id));
 794
 795     return $e->die_event unless
 796         $session and $e->allowed("URL_VERIFY", $session->owning_lib);
 797
 798     if ($session->creator != $e->requestor->id) {
 799         $e->disconnect;
 800         return new OpenILS::Event("URL_VERIFY_NOT_SESSION_CREATOR");
 801     }
 802
 803     my $delete_error =
 804         _check_for_existing_bucket_items($e, $session);
 805
 806     if ($delete_error) {
 807         $e->disconnect;
 808         return $delete_error;
 809     }
 810
 811     my ($search_error, @result_ids) =
 812         _get_all_search_results($client, $session);
 813
 814     if ($search_error) {
 815         $e->disconnect;
 816         return $search_error;
 817     }
 818
 819     $e->xact_begin;
 820
 821     # Make and save a bucket item for each search result.
 822
 823     my $pos = 0;
 824     my @item_ids;
 825
 826     # There's an opportunity below to parallelize the extraction of URLs if
 827     # we need to.
 828
 829     foreach my $bre_id (@result_ids) {
 830         my $bucket_item =
 831             Fieldmapper::container::biblio_record_entry_bucket_item->new;
 832
 833         $bucket_item->bucket($session->container);
 834         $bucket_item->target_biblio_record_entry($bre_id);
 835         $bucket_item->pos($pos++);
 836
 837         $e->create_container_biblio_record_entry_bucket_item($bucket_item) or
 838             return $e->die_event;
 839
 840         push @item_ids, $e->data->id;
 841     }
 842
 843     $e->xact_commit;
 844
 845     $client->respond($pos); # first response: the number of items created
 846                             # (number of search results)
 847
 848     # For each contain item, extract URLs.  Report counts of URLs extracted
 849     # from each record in batches at every hundred records.  XXX Arbitrary.
 850
 851     my @url_counts;
 852     foreach my $item_id (@item_ids) {
 853         my $res = $e->json_query({
 854             from => ["url_verify.extract_urls", $ses_id, $item_id]
 855         }) or return $e->die_event;
 856
 857         push @url_counts, $res->[0]{"url_verify.extract_urls"};
 858
 859         if (scalar(@url_counts) % 100 == 0) {
 860             $client->respond([ @url_counts ]);
 861             @url_counts = ();
 862         }
 863     }
 864
 865     $client->respond([ @url_counts ]) if @url_counts;
 866
 867     $e->disconnect;
 868     return;
 869 }
 870
 871
 872 1;