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